excel - 应用匹配功能如何复制粘贴数据

Question

使用 Application.Match 函数但不知道如何粘贴 Col"M"数据输入 Col"P"匹配后Col"O"和 Col"L" .
运行 Current 函数时，它会给出匹配计数。

任何帮助将不胜感激。

Dim k As Integer

For k = 2 To 9
ws2.Cells(k, 16).Value = Application.Match(ws2.Cells(k, 15).Value, ws2.Range("L2:L9"), 0)


Next k

我已经用列和需要结果的列编辑了代码。但是无法进行更改我非常感谢您对您进行此功能的帮助。我添加了一些评论可能会有所帮助。

' Sheet2 Col"C" with ID's
With ws2
   Dim lastRow As Long
   lastRow = .Range("A" & .Rows.Count).End(xlUp).Row

   Dim originalData() As Variant
   originalData = .Range("C2:C" & lastRow).Value
End With

' Sheet2 Col"C" with ID's
With ws3
   Dim lastRow2 As Long
   lastRow2 = .Range("A" & .Rows.Count).End(xlUp).Row
    
   Dim newData() As Variant
   newData = .Range("C2:C" & lastRow2).Value
End With


Dim i As Long
For i = LBound(newData, 1) To UBound(newData, 1)
    Dim j As Long
    
    For j = LBound(originalData, 1) To UBound(originalData, 2)
        If newData(i, 1) = originalData(j, 1) Then
            newData(i, 2) = originalData(j, 2)
            Exit For
        End If
    Next
Next

'Sheet2 Col"K" where Sheet3 Col"E" data will be pasted
ws2.Range("K2:K" & lastRow).Value = newData

Answer 1

当您需要执行大量查找时，将“键”映射到“值”的脚本字典通常是最快的方法。需要编写更多代码，但应该很快。

Sub DoLookup()

    Dim arrKeys, arrValues, wsData As Worksheet, wsDest As Worksheet
    Dim map As Object, rngSearch As Range, rngResults As Range, k, v, n As Long
    
    Set wsData = ThisWorkbook.Worksheets("Sheet3") 'sheet with the lookup table
    Set wsDest = ThisWorkbook.Worksheets("Sheet2") 'sheet to be populated
    
    arrKeys = wsData.Range("C2:C" & LastRow(wsData, "C")).Value   'keys in the lookup table
    arrValues = wsData.Range("G2:G" & LastRow(wsData, "C")).Value 'values in the lookup table

    Set map = MapValues(arrKeys, arrValues)                      'get a map of Keys->Values
    
    Set rngSearch = wsDest.Range("C2:C" & LastRow(wsDest, "c"))  'keys to look up
    Set rngResults = rngSearch.EntireRow.Columns("K")            'results go here
    
    arrKeys = rngSearch.Value     'keys to look up
    arrValues = rngResults.Value  'array to populate with results
    
    For n = 1 To UBound(arrKeys)  'loop over keys to look up
        v = ""  'or whatever you want to see if no match
        k = arrKeys(n, 1)
        If map.exists(k) Then v = map(k)
        arrValues(n, 1) = v
    Next n
    
    rngResults.Value = arrValues 'populate the results array back to the sheet

End Sub

'Return a Scripting Dictionary linking "keys" to "values"
' Note - assumes same-size single-column inputs, and that keys are unique,
'     otherwise you just map to the *last* value for any given key
Function MapValues(arrKeys, arrValues)
    Dim n, dict As Object, k
    Set dict = CreateObject("scripting.dictionary")
    For n = 1 To UBound(arrKeys, 1)
        k = CStr(arrKeys(n, 1)) 'string keys are faster to add?
        If Len(k) > 0 Then dict(k) = arrValues(n, 1)
    Next n
    Set MapValues = dict
End Function

'utility function
Function LastRow(ws As Worksheet, col As String) As Long
    LastRow = ws.Cells(ws.Rows.Count, col).End(xlUp).Row
End Function

在我的测试工作簿中，它能够在 <0.1 秒内对 10k 行的表执行 10k 次查找。