求助：VBA二维Variant数组部分填充问题，匹配工作表列号

我想用一个工作表的字符串集合，结合另一个工作表中更大字符串集合对应的列号，填充一个二维变体数组。步骤是先把两个工作表的值存入独立数组，再通过循环匹配填充最终数组。目前中间数组已经填满，但最终输出数组只有部分值，只能用立即窗口和Debug.Print调试。

参考工作表（第1个）的字符串垂直排列在A列；对比工作表（第2个）的字符串水平排列在第1行。

示例工作表 #

参考工作表 #

对比工作表 #

现有代码 #

Sub ColumnNumberAssign()

Dim ReferenceRowCount As Integer
Dim ComparisonColumnCount As Integer

Dim RefStrings(50, 2) As Variant, ComparisonStrings(1000) As String
Dim Counter As Integer

'Column Count for Comparison Sheet
    ComparisonColumnCount = 662
    
'Row Count for reference Sheet - There 31 Strings arranged vertically in the 1st sheet column
    ReferenceRowCount = 31 

'Populating RefStrings Array with Strings Reference Excel Sheet (Sheet 1 of 2)
    Worksheets("Reference").Activate
    For i = 2 To ReferenceRowCount
        RefStrings(i, 1) = Cells(i, 1)
    Next i

'Populating ComparisonStrings Array with Strings from Comparison Excel Sheet (Sheet 2 of 2)
'There are 662 string values arranged in the 1st Sheet Row
    Worksheets("Comparison").Activate
    For i = 2 To ComparisonColumnCount
        ComparisonStrings(i) = Cells(1, i)
    Next i

'Identifying the column numbers in the Comparison Sheet for the values in the RefStrings Array
    For i = 2 To ReferenceRowCount
        For b = 2 To ComparisonColumnCount
            If RefStrings(i, 1) = ComparisonStrings(b) Then RefStrings(i, 2) = b
        Next b
    Next i

'Debugging: Making Sure RefStrings Array is completely populated (*** Failed ***)
    For i = 1 To ReferenceRowCount
        Debug.Print RefStrings(i, 1), RefStrings(i, 2)
    Next i

End Sub

核心问题 #

1. 数组索引错位：RefStrings从i=2开始填充，但调试时从i=1打印，导致第一行数据为空，误判为部分填充。
2. 未声明循环变量：i和b未声明为明确类型，隐式变体类型可能引发匹配异常；同时未处理字符串的大小写差异和首尾空格/不可见字符，导致部分匹配失败。
3. 依赖工作表激活：Activate切换工作表易因焦点变化出错，且效率低下。

修正后的代码 #

Option Explicit ' 强制声明所有变量，杜绝隐式错误

Sub ColumnNumberAssign_Fixed()
    Dim ReferenceRowCount As Integer
    Dim ComparisonColumnCount As Integer
    Dim RefStrings() As Variant, ComparisonStrings() As Variant
    Dim i As Integer, b As Integer ' 明确声明循环变量
    
    ' 定义行列数
    ComparisonColumnCount = 662
    ReferenceRowCount = 31
    
    ' 直接读取参考工作表A列数据到数组（无需激活）
    RefStrings = Worksheets("Reference").Range("A2:A" & ReferenceRowCount).Value
    ' 扩展数组，添加第二列存储列号
    ReDim Preserve RefStrings(1 To UBound(RefStrings), 1 To 2)
    
    ' 直接读取对比工作表第一行数据到数组
    ComparisonStrings = Worksheets("Comparison").Range("B1:" & Split(Cells(1, ComparisonColumnCount).Address, "$")(1) & "1").Value
    ' 转置为一维数组，方便遍历
    ComparisonStrings = Application.Transpose(ComparisonStrings)
    
    ' 匹配字符串并填充列号
    For i = 1 To UBound(RefStrings, 1)
        RefStrings(i, 2) = Empty ' 初始化列号，避免残留值
        For b = 1 To UBound(ComparisonStrings)
            ' 忽略大小写和首尾空格，确保匹配准确性
            If Trim(UCase(RefStrings(i, 1))) = Trim(UCase(ComparisonStrings(b))) Then
                RefStrings(i, 2) = b + 1 ' 对比列从B列（第2列）开始，所以加1
                Exit For ' 找到匹配后立即退出内层循环，提升效率
            End If
        Next b
    Next i
    
    ' 调试打印（索引与数组实际存储对齐）
    For i = 1 To UBound(RefStrings, 1)
        Debug.Print RefStrings(i, 1), RefStrings(i, 2)
    Next i
End Sub

关键改进点 #

• Option Explicit：强制变量声明，避免因隐式类型导致的错误。
• 直接读取范围到数组：替代Activate和循环赋值，效率更高且避免焦点问题。
• 字符串匹配优化：用Trim和UCase处理空格与大小写，消除匹配盲区。
• 提前退出循环：找到匹配后立即终止内层循环，减少不必要的遍历。
• 索引对齐：数组起始索引设为1，与工作表行列号对应，避免混淆。

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