0

我想比较两个不同长度的 ID 列表。第一个列表较长并且有值，而第二个列表没有值。

在此处输入图像描述

当 ID 匹配时，它应该将第一个列表中的值粘贴到列表 2 旁边的适当位置。

Sub compareList()

Dim v1, v2, v4, v3()
Dim i As Long
Dim j As Long

v1 = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
v2 = Range("B2", Range("B" & Rows.Count).End(xlUp)).Value
v4 = Range("D2", Range("D" & Rows.Count).End(xlUp)).Value

ReDim v3(1 To 4)

For i = LBound(v1) To UBound(v1)
    If IsError(Application.Match(v1(i, 1), v4, 0)) Then
        j = j + 1
    Else
        v3(j) = v2(i, 1)
    End If
Next i

Range("E2").Resize(i) = Application.Transpose(v3)

End Sub

它给了我一个超出索引的错误，或者按照它读取它的顺序粘贴值（不注意匹配）。

4

2 回答 2

1

如果您不喜欢Vlookup并且需要一些 VBA 代码，请测试下一个代码：

Sub compareList()
Dim sh As Worksheet, lastR As Long, lastR2 As Long, i As Long, j As Long, arr, arrFin

Set sh = ActiveSheet
 lastR = sh.Range("A" & rows.count).End(xlUp).row
 lastR2 = sh.Range("D" & rows.count).End(xlUp).row
 arr = sh.Range("A2:B" & lastR).Value
 arrFin = sh.Range("D2:E" & lastR2).Value
 
 For i = 1 To UBound(arrFin)
    For j = 1 To UBound(arr)
        If arrFin(i, 1) = arr(j, 1) Then arrFin(i, 2) = arr(j, 2): Exit For
    Next j
 Next i
 sh.Range("D2:E" & lastR2).Value = arrFin
End Sub
于 2020-11-13T14:57:32.067 回答
1

继续并参考@FaneDuru 说明

如果您不喜欢Vlookup并且需要一些 VBA 代码：

1) 使用 Match() 的示例代码

Sub compareListTM()
'define arrays using help function getRange()
Dim arr:    arr = getRange(Sheet1.Range("A:A")).Value
Dim data:   data = getRange(Sheet1.Range("B:B")).Value
Dim arrFin: arrFin = getRange(Sheet1.Range("D:D")).Value

Dim ret:    ret = Application.Match(arrFin, arr, 0)   ' Match() items all at once :-)
Dim i As Long
For i = 1 To UBound(ret)
    If Not IsError(ret(i, 1)) Then
        ret(i, 1) = data(ret(i, 1), 1)
    Else
        ret(i, 1) = vbNullString
    End If
Next i
 
Sheet1.Range("E2").Resize(UBound(ret), 1).Value = ret
End Sub

但是，如果您可以VLookUp尝试一下：

2) 使用工作表函数的示例代码

Sub compareList2()
    Dim results
    results = WorksheetFunction.VLookup( _
                getRange(Sheet1.Range("D:D")), _
                getRange(Sheet1.Range("A:B")), _
                2, False)
    'write results
    Sheet1.Range("E2").Resize(UBound(results), 1).Value = results
End Sub

getRange()两个示例中使用的帮助功能

一种避免在主代码中重复 lastRow、Range 定义的方法。

我不假装这个功能是完美的，它只是满足了上述程序尽可能短的必要要求。

Function getRange(ColRange As Range, _
                  Optional ByVal SearchColumn As Variant = 1, _
                  Optional ByVal StartRow As Long = 2) As Range
'Author : https://stackoverflow.com/users/6460297/t-m
'Purpose: calculate lastrow of a given search column (default: 1st column of ColRange) and
'         return ColRange resized to calculated lastrow (considering optional StartRow argument)
'Par. 1 : assumes that ColRange is passed as ENTIRE COLUMN(S) range object, e.g. Range("X:Y")
'Par. 2 : a) a numeric SearchColumn argument refers to the ColRange's column index
'           (even outside ColRange, can be negative or higher than columns count in ColRange!)
'         b) a literal SearchColumn argument refers to the worksheet column as indicated (e.g. "B")
'Example: getRange(Sheet1.Range("X:Y"))      ... calculates lastrow of 1st column in colRange (i.e. in X)
'         getRange(Sheet1.Range("X:Y"), "B") ... calculates lastrow of column B in worksheet
'~~~~~~
    '1) get columns in ColRange
        Dim StartColumn As Long: StartColumn = ColRange.Columns(1).Column
        Dim LastColumn  As Long: LastColumn = ColRange.Columns(ColRange.Columns.Count).Column
    
    With ColRange.Parent            ' i.e. the worksheet
    '2) change numeric search column number to letter(s)
        If IsNumeric(SearchColumn) Then
            If SearchColumn + StartColumn - 1 < 1 Then  ' cols left of StartColumn must be at least "A"
                SearchColumn = "A"
            Else                                        ' get literal column name, e.g. column "D"
                SearchColumn = Split((.Columns(SearchColumn + StartColumn - 1).Address(, 0)), ":")(0)
            End If
        End If
    '3) get last row of SearchColumn
        Dim lastRow As Long: lastRow = .Range(SearchColumn & .Rows.Count).End(xlUp).Row
        If lastRow < StartRow Then lastRow = StartRow   ' avoid findings lower than start row
        
    '4) return data range as function result
        Set getRange = .Range(.Cells(StartRow, StartColumn), .Cells(lastRow, LastColumn))
    End With
End Function
于 2020-11-14T13:07:27.727 回答