基于列值前五位拆分大型Excel文件为多个工作表

以下是修改后的VBA代码，可实现按指定列值的前五位将数据拆分到独立工作表：

Sub SplitSheetIntoMultipleSheetsByFirstFiveChars()
    Dim objWorksheet As Excel.Worksheet
    Dim nLastRow, nRow, nNextRow As Integer
    Dim strColumnValue As String
    Dim objDictionary As Object
    Dim varColumnValues As Variant
    Dim varColumnValue As Variant
    Dim objSheet As Excel.Worksheet
    
    Set objWorksheet = ActiveSheet
    nLastRow = objWorksheet.Range("A" & objWorksheet.Rows.Count).End(xlUp).Row
    Set objDictionary = CreateObject("Scripting.Dictionary")
    
    ' 遍历数据行，提取列值前五位存入字典去重
    For nRow = 2 To nLastRow
        ' 提取A列值的前五位，若值长度不足5则返回全部内容
        strColumnValue = Left(CStr(objWorksheet.Range("A" & nRow).Value), 5)
        If Not objDictionary.Exists(strColumnValue) Then
           objDictionary.Add strColumnValue, 1
        End If
    Next
    
    varColumnValues = objDictionary.Keys
    
    ' 为每个前五位分组创建工作表并复制对应行
    For i = LBound(varColumnValues) To UBound(varColumnValues)
        varColumnValue = varColumnValues(i)
        Set objSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        ' 用前五位作为工作表名称
        objSheet.Name = varColumnValue
        ' 复制表头
        objWorksheet.Rows(1).EntireRow.Copy objSheet.Rows(1)
        
        ' 遍历数据行，匹配前五位后复制内容
        For nRow = 2 To nLastRow
            If Left(CStr(objWorksheet.Range("A" & nRow).Value), 5) = CStr(varColumnValue) Then
                objWorksheet.Rows(nRow).EntireRow.Copy
                nNextRow = objSheet.Range("A" & objSheet.Rows.Count).End(xlUp).Row + 1
                objSheet.Range("A" & nNextRow).PasteSpecial xlPasteValuesAndNumberFormats
            End If
        Next
        ' 自动调整列宽
        objSheet.Columns("A:H").AutoFit
    Next
End Sub

关键修改说明 #

• 提取前五位：使用Left(CStr(单元格值), 5)获取目标列值的前五个字符，确保统一按前缀分组；若单元格值长度不足5，会自动返回完整内容。
• 字典去重：字典存储的不再是完整列值，而是提取后的前五位，确保每个前缀只创建一个工作表。
• 匹配逻辑：复制数据时同样用Left提取前五位进行对比，确保所有前缀一致的行都被分到对应工作表。

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