如何用vba宏自动匹配行列数不定区域内的值

宏初学者

原始需要匹配的数据区域从D列的数据开始，后面的数据，根据sheet2匹配对应的值，然后在区域最后面隔一列空列开始将匹配好的值输出。（原始数据的行列数不定，表格列举部分信息）

ABC列的区域不用替换，有时候有数据，有时候没有任何数据

swl4561255

1. Sub test()
   
2. Dim r As Range
   
3. ar = Sheets("sheet2").Range("A1").End(4).Row
   
4. arr = Sheets("sheet2").Range("A2:C" & ar)
   
5. brr = Range("D1").CurrentRegion
   
6. Set d = CreateObject("Scripting.Dictionary")
   
7. For i = 1 To UBound(arr)
   
8.     d(arr(i, 3)) = arr(i, 1)
   
9. Next
   
10. For Each r In Range("D1").CurrentRegion
    
11.     If d.exists(r.Value) Then
    
12.         r = d(r.Value)
    
13.     End If
    
14. Next
    
15. [A1].Resize(UBound(brr), UBound(brr, 2)) = brr
    
16. End Sub
    

复制代码

gwjkkkkk

字典应该最简单吧。。。

gwjkkkkk

Option Explicit
Sub TEST2()
    Dim ar, i&, r&, Rng As Range, rngFind As Range
   
    Application.ScreenUpdating = False
   
    With Intersect(Columns("D:H"), ActiveSheet.UsedRange)
        Set Rng = Intersect(.Offset(), .Offset(1))
    End With
   
    With Sheets(2)
        r = .Cells(Rows.Count, "A").End(xlUp).Row
        ar = .Range("A2:C" & r).Value
    End With
   
    For i = 1 To UBound(ar)
        Set rngFind = Rng.Find(ar(i, 1), , , xlWhole)
        If Not rngFind Is Nothing Then
            Do
                rngFind.Value = ar(i, 3)
                Set rngFind = Rng.FindNext(rngFind)
            Loop Until rngFind Is Nothing
        End If
    Next i
   
    Set Rng = Nothing: Set rngFind = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

参与一下。。。

宏初学者

swl4561255 发表于 2024-5-10 17:53

哈哈，不好意思，可能是我没表达清楚，匹配后是在后面输出，比如在J列，不是覆盖原来（不输出ABC列内容）

宏初学者

gwjkkkkk 发表于 2024-5-10 18:56
Option Explicit
Sub TEST2()
    Dim ar, i&, r&, Rng As Range, rngFind As Range

感谢感谢，不好意思，可能是我没表达清楚，匹配后是在后面输出，比如在J列，不是覆盖原来（不输出ABC列内容）

ooluckydog

沈默00

沈默00

结果放在P列，，