使用VBA按多条件创建分国家的Type表格技术咨询

嘿，作为VBA新手，这个按国家拆分表格的需求其实挺常见的，咱们一步步来拆解实现，保证你能轻松上手～

核心思路 #

• 先从原表「Censors Market Value」中提取所有不重复的国家（US、Canada、Mexico）
• 为每个国家新建专属工作表，命名规则比如「US Censors value by type」
• 将对应国家的Type数据复制到新表，再添加Year列并填充指定年份

新手友好的VBA代码实现 #

直接把这段代码复制到Excel的VBA编辑器里（按Alt+F11打开），注释里写了每个步骤的作用，你可以跟着调整：

Sub SplitCensorsByCountry()
    ' 声明变量，新手不用纠结细节，先跟着用就好
    Dim wsSource As Worksheet
    Dim wsNew As Worksheet
    Dim lastRow As Long
    Dim i As Long, j As Long
    Dim countryList As Collection
    Dim countryName As Variant
    
    ' 指向原数据所在的工作表（改成你实际的工作表名称）
    Set wsSource = ThisWorkbook.Worksheets("Censors Market Value")
    ' 创建集合存储不重复的国家
    Set countryList = New Collection
    
    ' 第一步：提取所有不重复的国家
    On Error Resume Next ' 避免重复添加国家时触发报错
    lastRow = wsSource.Cells(wsSource.Rows.Count, "B").End(xlUp).Row ' 获取B列最后一行数据
    For i = 2 To lastRow ' 从第2行开始，默认第1行是表头
        countryList.Add wsSource.Cells(i, "B").Value, Key:=CStr(wsSource.Cells(i, "B").Value)
    Next i
    On Error GoTo 0 ' 恢复正常错误提示
    
    ' 第二步：为每个国家创建新表并填充数据
    For Each countryName In countryList
        ' 新建工作表
        Set wsNew = ThisWorkbook.Worksheets.Add
        ' 按要求给新表命名
        wsNew.Name = countryName & " Censors value by type"
        
        ' 复制原表的Type表头和对应数据
        wsSource.Range("A1").Copy wsNew.Range("A1") ' 复制Type表头
        j = 2 ' 新表数据起始行
        For i = 2 To lastRow
            If wsSource.Cells(i, "B").Value = countryName Then
                wsSource.Cells(i, "A").Copy wsNew.Cells(j, "A") ' 复制匹配的Type
                j = j + 1
            End If
        Next i
        
        ' 添加Year列并填充年份（把"2024"改成你需要的年份即可）
        wsNew.Range("B1").Value = "Year"
        wsNew.Range("B2:B" & j - 1).Value = "2024" ' 自动填充到最后一行数据
        
        ' 自动调整列宽，让表格更美观
        wsNew.Columns("A:B").AutoFit
    Next countryName
    
    MsgBox "拆分完成！每个国家的专属表格都已创建～"
End Sub

新手必看注意事项 #

• 启用宏：保存文件时要选择「启用宏的工作簿（.xlsm）」格式，否则代码会丢失
• 表头位置：默认原表第1行是表头（A1=Type，B1=Country），如果你的表头位置不同，要修改代码里的行号
• 年份调整：代码里的"2024"可以改成任意你需要的年份，也可以改成引用某个单元格的动态值
• 调试技巧：如果运行出错，按F8一步步执行代码，能快速定位问题所在

内容的提问来源于stack exchange，提问作者Rishi