0

長さの異なる 2 つの ID リストを比較したい。最初のリストはより長く、値がありますが、2 番目のリストには値がありません。

ここに画像の説明を入力

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

VBA コードが気に入らずVlookup、必要な場合は、次のコードをテストしてください。

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 に答える