VBA ListBox数据匹配Sheet9指定行列存储问题求助

问题核心 #

需要将ListBox1中每行的Time数据，根据对应的Month（匹配Sheet9第1行的月份）和Color（匹配Sheet9A列的颜色），精准写入到Sheet9的交叉单元格中。

常见错误代码示例 #

这类问题的现有代码通常会忽略匹配逻辑，直接按顺序写入，比如：

Private Sub SaveBtn_Click()
    Dim i As Integer
    Dim ws9 As Worksheet
    Set ws9 = ThisWorkbook.Sheets("Sheet9")
    
    For i = 0 To ListBox1.ListCount - 1
        ' 错误：未匹配Month和Color，直接按固定行列写入
        ws9.Cells(i + 2, 2).Value = ListBox1.List(i, 2)
    Next i
End Sub

修改后的代码 #

Private Sub SaveBtn_Click()
    Dim ws9 As Worksheet
    Dim listRow As Integer
    Dim monthCol As Integer
    Dim colorRow As Integer
    
    Set ws9 = ThisWorkbook.Worksheets("Sheet9")
    
    ' 遍历ListBox所有行数据
    For listRow = 0 To ListBox1.ListCount - 1
        ' 定位当前Month在Sheet9第1行的列号
        On Error Resume Next
        monthCol = ws9.Rows(1).Find(What:=ListBox1.List(listRow, 0), _
                                   LookIn:=xlValues, LookAt:=xlWhole).Column
        On Error GoTo 0
        
        ' 定位当前Color在Sheet9A列的行号
        On Error Resume Next
        colorRow = ws9.Columns(1).Find(What:=ListBox1.List(listRow, 1), _
                                   LookIn:=xlValues, LookAt:=xlWhole).Row
        On Error GoTo 0
        
        ' 找到有效匹配后写入Time数据
        If monthCol > 0 And colorRow > 0 Then
            ws9.Cells(colorRow, monthCol).Value = ListBox1.List(listRow, 2)
        End If
    Next listRow
    
    MsgBox "数据已成功匹配保存", vbInformation
End Sub

关键说明 #

• 匹配逻辑：使用Find方法精准定位Month对应的列和Color对应的行，确保数据写入正确的交叉单元格
• 错误处理：加入On Error Resume Next避免因找不到匹配项导致代码崩溃，若未找到匹配则跳过该行数据
• 列索引调整：如果ListBox中Month/Color/Time的列顺序不同（比如Month是第1列），请修改ListBox1.List(listRow, X)中的索引值（从0开始计数）

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