返回列表 上一主題 發帖

將多個檔案同一個欄位資料複製集中到1個檔案

Sub test2()
Set CN = CreateObject("adodb.connection"): V = Application.Version
If V >= 12 Then V = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;"
If V < 12 Then V = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;"
Set s = Sheets("順序"): Set s0 = Sheets("集中"): s0.Cells.ClearContents
AR = Array("select * from [sheet1$A:I]", "select * from [工作表1$A:I]")
For i = 2 To s.Cells(Rows.Count, 2).End(3).Row
If Dir(ThisWorkbook.Path & "\" & s.Cells(i, "C") & ".xlsx") <> "" Then
    CN.Open V & "Data Source=" & ThisWorkbook.Path & "\" & s.Cells(i, "C") & ".xlsx"
    On Error Resume Next
    Set rs = CN.Execute("select * from [" & s.Cells(i, "D") & "$A:I]")
    If CN.Errors.Count <> 0 Then: CN.Errors.Clear: Set rs = CN.Execute(AR(0))
    If CN.Errors.Count <> 0 Then: CN.Errors.Clear: Set rs = CN.Execute(AR(1))
    On Error GoTo 0
    s0.Range(s.Cells(i, "E") & 2).CopyFromRecordset rs
    s0.Columns(s.Cells(i, "E").Value).NumberFormatLocal = "h:mm:ss;@"
    s0.Range(s.Cells(i, "E") & 6).Resize(1, 9) = Split("A,B,C,D,E,F,G,H,I", ",")
    CN.Close
End If
Next
End Sub

TOP

回復 7# Andy2483


youtube  SQL SERVER  安裝
youtube  SSMS 安裝
youtube  OR  bilibili 尚硅谷 SQL教程
   
GPT4
ADODB.Connection

另外可擴充學習
chrome 遠端功能
vmware1.6

TOP

        靜思自在 : 【時日莫空過】一個人在世間做了多少事,就等於壽命有多長。因此必須與時間競爭,切莫使時日空過。
返回列表 上一主題