类似于VLOOKUP取值

sampsonpon

具体如图

醉眼看尘世

‘数据量少，可以学习使用单元格的Find方法在Market表中;数据量大，可以学习字典把Market表装入字典
下面的代码，使用单元格的find方法实现

1. Option Compare Text
   
2. Sub test()
   
3. Dim rG As Range, Arr, i&, j&
   
4. Arr = Sheet1.[a1].CurrentRegion
   
5. ReDim Brr(1 To UBound(Arr, 1), 1 To 1)
   
6. Brr(1, 1) = "MARKET2"
   
7. For i = 2 To UBound(Arr, 1)
   
8.     If Arr(i, 6) = "B" Then
   
9.         Brr(i, 1) = "不同"
   
10.     Else
    
11.         Set rG = Sheet4.Range("A:A").Find(Arr(i, 12))
    
12.         If Not rG Is Nothing Then Brr(i, 1) = rG.Offset(0, 1)
    
13.     End If
    
14. Next i
    
15. Sheet1.[s1].Resize(UBound(Brr, 1), 1) = Brr
    
16. End Sub
    

复制代码

sampsonpon

醉眼看尘世 发表于 2024-9-21 17:27
‘数据量少，可以学习使用单元格的Find方法在Market表中;数据量大，可以学习字典把Market表装入字典
下面 ...

数据量大，几十万条

quqiyuan

用字典，速度应该会好很多，仅供参考。。。

quqiyuan

代码如下。。。
Sub test()
    Set d = CreateObject("scripting.dictionary")
    With Sheets("Market")
        arr = .[a1].CurrentRegion
        For i = 2 To UBound(arr)
            d(arr(i, 1)) = arr(i, 2)
        Next
    End With
    With Sheet1
        arr = .[a1].CurrentRegion
        ReDim brr(1 To UBound(arr) - 1, 1 To 1)
        For i = 2 To UBound(arr)
            If arr(i, 6) = "B" Then
                brr(i - 1, 1) = "不同"
            Else
                If d.exists(arr(i, 12)) Then brr(i - 1, 1) = d(arr(i, 12))
            End If
        Next
        .[r2].Resize(UBound(brr)) = brr
    End With
    Beep
    Set d = Nothing
End Sub