九色国产,午夜在线视频,新黄色网址,九九色综合,天天做夜夜做久久做狠狠,天天躁夜夜躁狠狠躁2021a,久久不卡一区二区三区

'34，多工作簿多工作表匯總(GetObject)

'http://club.excelhome.net/thread-1113886-1-1.html'結(jié)果表.xlsm'2014-4-20

Sub lqxs()

    Dim Arr1, myPath$,myName$, shnm, nm

    Dim j&, i&, d,y&, n&, Arr

   Application.ScreenUpdating = False

    Set d =CreateObject("Scripting.Dictionary")

    Sheet1.Activate

    Arr1 =[a1].CurrentRegion

    For i = 2 ToUBound(Arr1)

       If Arr1(i, 3) = "?" Or Arr1(i, 6) = "?" Or Arr1(i, 9) ="?" Then

           d(Arr1(i, 2)) = i

       End If

    Next

    nm =Array("3.xlsx", "2.xlsx", "1.xlsx")

    shnm = Array("優(yōu)先1", "次優(yōu)", "次次優(yōu)")

    myPath =ThisWorkbook.PATH & "\數(shù)據(jù)源\"

    For i = 0 To UBound(nm)

       myName = Dir(myPath & nm(i))

       With GetObject(myPath & myName)

           For y = 0 To 2

               Arr = .Sheets(shnm(y)).[a1].CurrentRegion

               For j = 2 To UBound(Arr)

                   If d.exists(Arr(j, 1)) Then

                       n = d(Arr(j, 1))

                       If Arr1(n, 3) = "?" Then Arr1(n, 3) = Arr(j, 3)

                       If Arr1(n, 6) = "?" Then Arr1(n, 6) = Arr(j, 4)

                       If Arr1(n, 9) = "?" Then Arr1(n, 9) = Arr(j, 5)

                       Exit For

                    EndIf

               Next

           Next

           .Close False

       End With

    Next

    [a1].CurrentRegion =Arr1

   Application.ScreenUpdating = True

End Sub

'2013-5-5

'http://club.excelhome.net/thread-1014109-1-1.html

Sub lqxs()

    Dim Arr, myPath$,myName$, col%, m&, sh As Worksheet

    Dim j&, i&, d,nm, n&, Brr(1 To 5000, 1 To 20), c%, d1

   Application.ScreenUpdating = False

    Set d =CreateObject("Scripting.Dictionary")

    Set d1 =CreateObject("Scripting.Dictionary")

    Sheet1.Activate

    [a:h].ClearContents

    myPath =ThisWorkbook.PATH

    aa = InStrRev(myPath,"\")

    myPath = Left(myPath,aa) & "數(shù)據(jù)源\"

    myName = Dir(myPath& "*.xlsx")

    Do While myName <>""

       With GetObject(myPath & myName)

           For Each sh In .Sheets

               If InStr(sh.Name, "數(shù)據(jù)源") Then

                   Arr = sh.[a1].CurrentRegion

                   For j = 1 To UBound(Arr, 2)

                       If Arr(2, j) <> "" Then

                           If Not d.exists(Arr(2, j)) Then c = c + 1: d(Arr(2, j)) = c

                           col = d(Arr(2, j))

                           For i = 3 To UBound(Arr)

                               If Not d1.exists(Arr(i, 2)) Then m = m + 1

                                   d1(Arr(i,2)) = m

                                   Brr(m, col) = Arr(i, j)

                               Else

                                   m = d1(Arr(i, 2))

                                   Brr(m, col) = Arr(i, j)

                               EndIf

                           Next

                       End If

                   Next

               End If

           Next

           .Close False

       End With

       myName = Dir

    Loop

    [a1].Resize(1, d.Count)= d.keys

    [a2].Resize(m, d.Count)= Brr

   Application.ScreenUpdating = True

End Sub