VBA 在列中搜索数组并根据绑定到数组的值替换单元格值

Question

我为“输入”中的数字条目（C 列）创建了一个数组，并将使用它在“目标”的 G 列中进行搜索。

如果有匹配项，请将“Destination”的行值替换为与“Input”中相应列的数组相关联的值。例如，我将使用“输入”中的数字 13579 并在“目标”中的 G 列下搜索，当匹配时，使用与“输入”中的 13579 相关联的日期（A 列）和人员（B 列）值并替换单元格相同列的“目的地”中的值（B 列代表日期，D 列代表人物）。

“输入”工作表

“目的地”工作表

我是 VBA 新手，尝试了自己的逻辑并得到“需要对象”错误。我标记了“需要帮助”的部分（接近代码末尾）。谢谢！

Sub ReplaceValue()

    ' Use entries in Input worksheet as filter criteria for Summary worksheet, copy data to
    ' Destination worksheet and replace cell value based on Input array.

    Application.ScreenUpdating = False

    Dim srcWS As Worksheet, inputWS As Worksheet, desWS As Worksheet
    Dim cell As Variant, c As Variant
    
    Set srcWS = ThisWorkbook.Sheets("Summary") ' Thousands of rows
    Set inputWS = ThisWorkbook.Sheets("Input")
    Set desWS = ThisWorkbook.Sheets("Destination")
    
    srcWS.AutoFilterMode = False
    
    ' Declare an array to hold filtered criteria
    Dim inputList() As String

    ' Declare a counter for inputList array
    Dim n As Integer

    n = Application.WorksheetFunction.CountA(inputWS.Range("C:C")) - 2 ' Column has header

    ReDim inputList(n) As String

    Dim i As Integer

    For i = 0 To n
        inputList(i) = inputWS.Range("C" & i + 2)
    Next i
    
    ' Use Input array to filter the Summary worksheet and copy data to the Destination worksheet
    With srcWS.UsedRange
        .AutoFilter 7, inputList(), xlFilterValues
        .Offset(1).Resize(.Rows.Count - 1).Copy desWS.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        '.AutoFilter
    End With
    
    ' Loop through Input array
    For Each cell In inputList
        If IsError(Application.Match(cell, desWS.Range("G:G"), 0)) Then
            MsgBox (cell & " Not Found")
        Else
            
            ' This is where help is needed. Got "Object required" error.
            For Each c In desWS.Range("G:G")
                desWS.Cells(c.Row, 2).Value2 = inputWS.Cells(cell.Row, 1).Value2 ' Copied Date
                desWS.Cells(c.Row, 4).Value2 = inputWS.Cells(cell.Row, 2).Value2 ' Copied Person
            Next c
        End If
    Next cell
   
        
    srcWS.AutoFilterMode = False
    
    ' Display to user the last row in the Destination worksheet
    desWS.Activate
    Range("C" & Rows.Count).End(xlUp).Select
   
    Application.ScreenUpdating = True

End Sub

Answer 1

如果有人感兴趣，这里是答案。我还更改了数组的创建方式。干杯！

Sub ReplaceValue()

   ' Use entries in Input worksheet as filter criteria for Summary worksheet, copy 
   ' data to Destination worksheet and replace cell value based on Input array.

    Dim inputWS As Worksheet, srcWS As Worksheet, desWS As Worksheet
    Dim inputRange As Range, srcRange As Range, cell As Range, c As Range
    Dim lastRow As Long
    Dim inputList As Variant
    
    Set srcWS = ThisWorkbook.Sheets("Summary")
    Set inputWS = ThisWorkbook.Sheets("Input")
    Set desWS = ThisWorkbook.Sheets("Destination")
    
    With inputWS
        lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
        Set inputRange = .Range("C2:C" & lastRow)
    End With
    
    ' Used to transpose as autofilter criteria
    inputList = inputRange.Value

    With srcWS
        lastRow = .Cells(.Rows.Count, "G").End(xlUp).Row
        Set srcRange = .Range("G2:G" & lastRow)
    End With
      
    ' Filter input criteria in Summary worksheet and copy to Destination worksheet
    With srcWS.UsedRange
        .AutoFilter 7, Application.Transpose(inputList), xlFilterValues
        .Offset(1).Resize(.Rows.Count - 1).Copy desWS.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
        '.AutoFilter
    End With
    
    For Each cell In inputRange
        If IsError(Application.Match(cell, desWS.Range("G:G"), 0)) Then
            MsgBox (cell & " Not Found")
        Else
            For Each c In desWS.Range("G:G")
                If cell.Value = c.Value Then
                    desWS.Cells(c.Row, 2).Value = inputWS.Cells(cell.Row, 1).Value ' Replaced Date
                    desWS.Cells(c.Row, 4).Value = inputWS.Cells(cell.Row, 2).Value ' Replaced Person
                End If
            Next c
        End If
    Next cell

    srcWS.AutoFilterMode = False

    desWS.Activate
    Range("C" & Rows.Count).End(xlUp).Select
    
    Application.ScreenUpdating = True

End Sub

Answer 2

你想循环遍历 Cells ：

For Each c In desWS.Range("G:G").Cells