返回列表 上一主題 發帖

[發問] 如何讓不同檔案同一貨號自動匯入總表

回復 3# s7659109
  1. Sub Import_Data()
  2. Dim Sh As Worksheet, A As Range, Ar(), Ay(0 To 7), s&, Sn$, cnt#, cnt1#
  3. Sn = InputBox("輸入查詢貨號", , "001")
  4. For Each Sh In Sheets
  5. If Sh.Name Like "A*" Then
  6.    With Sh
  7.       For Each A In .Range("B:B").SpecialCells(xlCellTypeConstants)
  8.         If A = Sn Then
  9.             For i = -1 To 6
  10.                Ay(i + 1) = A.Offset(, i)
  11.             Next
  12.            ReDim Preserve Ar(s)
  13.            Ar(s) = Ay
  14.            cnt = cnt + Ay(4)
  15.            cnt1 = cnt1 + Ay(7)
  16.            s = s + 1
  17.         End If
  18.       Next
  19.     End With
  20. End If
  21. Next
  22. With Sheet4
  23. .UsedRange.Offset(2) = ""
  24. If s > 0 Then
  25. ReDim Preserve Ar(s)
  26. Ar(s) = Array("合計", "", "", "", cnt, "", "", cnt1)
  27. s = s + 1
  28. .Columns("B:B").NumberFormat = "@"
  29. .[A3].Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
  30. Else
  31. MsgBox "無符合資料"
  32. End If
  33. End With
  34. End Sub
複製代碼
學海無涯_不恥下問

TOP

回復 5# s7659109
  1. Sub ex()
  2. Dim Sn$, Fs, F, Ar()
  3. Sn = InputBox("請輸入查詢貨號", , "001")
  4. Fs = Application.GetOpenFilename("Excel Files(*.xls),*.xls", , "請選擇檔案(可複選)", , True)
  5. If Not IsArray(Fs) Then MsgBox "請選擇檔案": Exit Sub
  6. For Each F In Fs
  7.    With Workbooks.Open(F)
  8.       With .Sheets(1)
  9.          For Each a In .Range("B:B").SpecialCells(xlCellTypeConstants)
  10.             If a = Sn Then
  11.                ay = a.Offset(, -1).Resize(, 8).Value
  12.                ReDim Preserve Ar(s)
  13.                Ar(s) = ay
  14.                s = s + 1
  15.             End If
  16.          Next
  17.       End With
  18.       .Close 0
  19.     End With
  20. Next
  21. With ThisWorkbook.Sheets("總表")
  22. .UsedRange.Offset(2) = ""
  23. If s > 0 Then
  24.   .[A1] = Sn
  25.   .[A3].Resize(s, 8) = Application.Transpose(Application.Transpose(Ar))
  26.   Else
  27.   MsgBox "沒有符合資料"
  28. End If
  29. End With
  30. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 原諒別人就是善待自己。
返回列表 上一主題