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

问题描述

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

如果存在匹配项，则将“目标”的行值替换为与“输入”中对应列的数组相关联的值。例如，我将使用“输入”中的数字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

解决方法

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

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

,

您要遍历单元格：

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