在VBA中将两列表格数据按键值对存入Collection

核心思路 #

直接定位A列的有效数据范围，遍历每个A列单元格时，通过同一行偏移获取对应B列的值，将A列值作为Key、B列值作为Item存入Collection。如果需要基于已用区域遍历，也可以直接取每行的第1、2列数据。

方法一：直接遍历A列有效数据 #

这种方式更高效，仅遍历A列有数据的单元格：

Sub AddABToCollection()
    Dim dataCol As New Collection
    Dim targetSheet As Worksheet
    Dim lastDataRow As Long
    Dim currentCell As Range
    
    ' 指定目标工作表（替换成你的表名，比如"Sheet2"）
    Set targetSheet = ThisWorkbook.Worksheets("Sheet1")
    
    ' 获取A列最后一行有数据的行号
    lastDataRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
    
    ' 遍历A列第1行到最后一行的单元格
    For Each currentCell In targetSheet.Range("A1:A" & lastDataRow)
        ' 跳过A列空单元格（按需保留）
        If currentCell.Value <> "" Then
            ' 处理重复键：避免A列值重复导致报错
            On Error Resume Next
            dataCol.Add Item:=currentCell.Offset(0, 1).Value, Key:=CStr(currentCell.Value)
            On Error GoTo 0
        End If
    Next currentCell
    
    ' 可选：验证存入结果（在立即窗口输出）
    Dim idx As Integer
    For idx = 1 To dataCol.Count
        Debug.Print "键: " & dataCol.Key(idx) & "，值: " & dataCol(idx)
    Next idx
End Sub

方法二：基于已用区域遍历 #

如果你的代码原本就在遍历已用区域，可以直接取每行的A、B列数据：

Sub AddFromUsedRange()
    Dim dataCol As New Collection
    Dim targetSheet As Worksheet
    Dim usedRow As Range
    Dim keyVal As Variant, itemVal As Variant
    
    Set targetSheet = ThisWorkbook.Worksheets("Sheet1")
    
    ' 遍历已用区域的每一行
    For Each usedRow In targetSheet.UsedRange.Rows
        keyVal = usedRow.Cells(1).Value ' 每行第1列（A列）
        itemVal = usedRow.Cells(2).Value ' 每行第2列（B列）
        
        If keyVal <> "" Then
            On Error Resume Next
            dataCol.Add Item:=itemVal, Key:=CStr(keyVal)
            On Error GoTo 0
        End If
    Next usedRow
    
    ' 可选：验证结果
    For idx = 1 To dataCol.Count
        Debug.Print "键: " & dataCol.Key(idx) & "，值: " & dataCol(idx)
    Next idx
End Sub

关键细节说明 #

• 获取对应B列值：用currentCell.Offset(0, 1)表示当前A列单元格向右偏移1列（即同一行的B列），也可以用targetSheet.Cells(currentCell.Row, 2)，效果完全一致。
• 重复键处理：Collection的Key必须唯一，加入On Error Resume Next会自动跳过重复键的存入操作；如果需要提示重复或覆盖旧值，可以修改错误处理逻辑（比如捕获错误后给出提示）。
• 空值过滤：代码中加入了If currentCell.Value <> ""判断，避免将A列空单元格作为无效键存入，可根据实际需求删除该判断。

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