VBA数组赋值问题咨询：基于去重数据批量创建工作表

嘿，我懂你在VBA数组使用上的困惑，咱们一步步把这个问题捋清楚——把A列的字符串去重，然后给每个唯一值新建一个独立工作表。先看完整的实现代码，再拆解每一步的逻辑：

Sub CreateSheetsFromUniqueValues()
    Dim wsSource As Worksheet
    Dim lastRow As Long
    Dim arrValues As Variant
    Dim uniqueDict As Object
    Dim key As Variant
    Dim newWs As Worksheet
    Dim i As Integer
    
    ' 锁定源工作表（就是存A列数据的那张表）
    Set wsSource = ActiveSheet
    ' 动态获取A列最后一行的行号，适配数据数量变化
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
    
    ' 把A列数据一次性读入数组，比逐个单元格读取高效得多
    arrValues = wsSource.Range("A1:A" & lastRow).Value
    
    ' 用字典实现自动去重（字典的键天生唯一，重复值会被自动忽略）
    Set uniqueDict = CreateObject("Scripting.Dictionary")
    
    ' 遍历数组，把非空值存入字典
    For i = 1 To UBound(arrValues)
        If arrValues(i, 1) <> "" Then
            uniqueDict(arrValues(i, 1)) = arrValues(i, 1)
        End If
    Next i
    
    ' 遍历字典里的每个唯一值，创建对应工作表
    For Each key In uniqueDict.Keys
        ' 先检查工作表是否已存在，避免重名报错
        On Error Resume Next
        Set newWs = ThisWorkbook.Worksheets(key)
        On Error GoTo 0
        
        ' 如果工作表不存在，就新建并命名
        If newWs Is Nothing Then
            Set newWs = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
            newWs.Name = key
        End If
        
        ' 重置对象变量，避免后续循环出错
        Set newWs = Nothing
    Next key
    
    MsgBox "搞定！一共创建了" & uniqueDict.Count & "个独立工作表", vbInformation
End Sub

关键细节说明： #

• 动态适配数据量：用wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row获取最后一行，不管A列有15个还是更多数据，都能精准覆盖，比你之前用固定长度数组灵活太多。
• 数组读取的优势：一次性把整列数据读入数组，比循环逐个读单元格速度快很多，数据量越大越明显。
• 字典去重的便捷性：Scripting.Dictionary是VBA处理去重的最优选择之一，不用手动写复杂的重复判断逻辑，直接利用键的唯一性自动去重。
• 避免重名报错：新增工作表前先检查是否已存在，防止因为重复名称导致代码崩溃。

对你原代码的小提示： #

你之前定义的Dim myArray(20) As Variant是固定长度数组，但A列数量不固定的话，完全不需要指定长度——直接用动态数组Dim arrValues As Variant，再通过arrValues = Range(...).Value自动适配数据长度就好，这样兼容性更强。

如果你的A列有表头（比如A1是标题），只需要把读取范围改成A2:A" & lastRow，就能跳过表头啦。

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