求助将sheet1中数据填入sheet2表格？谢谢！

1249994139

Sub 查询填表()
    Dim DicR, DicC, arr1, arr2, x&, y&, k&, kk&, St$
    Set DicR = CreateObject("scripting.dictionary")
    Set DicC = CreateObject("scripting.dictionary")
    arr1 = Sheets(1).Range("a1").CurrentRegion
    For x = 3 To UBound(arr1)
        If Not DicC(arr1(x, 3)) Then
            kk = kk + 1
            DicC(arr1(x, 3)) = kk
        End If
        St = arr1(x, 5) & arr1(x, 3)
        DicR(St) = arr1(x, 6)
    Next x
   
    Sheets(2).Activate
    [b1].Resize(1, DicC.Count) = DicC.keys
    arr2 = Range("a1").CurrentRegion
    For x = 2 To UBound(arr2)
        For y = 2 To UBound(arr2, 2)
            St = arr2(x, 1) & VBA.Format(arr2(1, y), "yyyy-mm-dd")
            If DicR.exists(St) Then
                arr2(x, y) = DicR(St)
            End If
        Next y
    Next x
    [a1].Resize(UBound(arr2), UBound(arr2, 2)) = arr2
End Sub

wangweihebtu

1249994139 发表于 2020-2-5 20:18
Sub 查询填表()
    Dim DicR, DicC, arr1, arr2, x&, y&, k&, kk&, St$
    Set DicR = CreateObject("s ...

您好，我比较菜，看看我的理解对不：二楼的代码在sheet2中用的是遍历，代码比较短，运行起来效率稍低。您用了两个字典，所以效率相对较高。