用VBA实现两个工作簿数据的匹配

Qs18

Sub qs()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Dim pth, arr, ar, brr, rng As Range
    Dim strSQL, str_cnn
    strPath = ThisWorkbook.Path & "\大表2.xlsx"
    Set cnn = CreateObject("adodb.connection")
    If Application.Version < 12 Then
        str_cnn = "Provider=Microsoft.jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source=" & strPath
    Else
        str_cnn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & strPath
    End If
    cnn.Open str_cnn
   
    strSQL = "SELECT * FROM [工单明细报表$a:c] where 申请书号 is not null"
    Set rst = cnn.Execute(strSQL)
    arr = rst.GetRows
    ReDim ar(0 To UBound(arr, 2), 0 To UBound(arr))
    For i = 0 To UBound(arr, 2)
        For j = 0 To UBound(arr)
            ar(i, j) = arr(j, i)
        Next
    Next
    brr = Sheet1.Range("a1").CurrentRegion.Value
    With Sheet1
        
        For x = 2 To UBound(brr)
            For j = 0 To UBound(ar)
                If brr(x, 1) = ar(j, 0) Then
                    brr(x, 2) = Date
                    brr(x, 3) = ar(j, 1)
                    brr(x, 4) = ar(j, 2)
                    Exit For
                End If
               
            Next
        Next
        Sheet1.Range("a1").Resize(UBound(brr), UBound(brr, 2)) = brr
    End With
    cnn.Close
    Set cnn = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Qs18

试试............

Qs18

试试..........

会飞的土豆宏宏

hacker85 发表于 2024-8-18 15:35
这是字典用法。一句两句说不清楚，你可以到抖音、B站等VBA播主的页面上去学习一下字典的用法，就明白了。 ...

好久的帖子了哈哈，谢谢，虽然我仍然是个菜鸟哈哈

hacker85

Qs18 发表于 2024-8-18 16:46
试试..........

您好！   可否移步到这个地址研究一下这个问题
https://club.excelhome.net/thread-505129-1-1.html