楼主
xmyjk |
Q:如何使用VBA汇总同一文件夹下的各个表数据至汇总表中
A:- Option Explicit
- Sub 按钮1_单击()
- Dim myPath As String, myFile As String, Wb As Workbook, i As Long, arr, n As Long, brr, j As Integer, k As Integer
- Dim mc As String, fhd As String, dz As String, rq As Date, lxr As String, dh As String, nm As Long
-
- [a1].CurrentRegion.Offset(1).Clear
- Application.ScreenUpdating = False
- myPath = ThisWorkbook.Path & "\"
-
- myFile = Dir(myPath & "*.xls")
- Do While myFile <> ""
- If myFile <> ThisWorkbook.Name Then
- Set Wb = Workbooks.Open(myPath & myFile)
- For i = 1 To Wb.Sheets.Count
- If InStr(Wb.Worksheets(i).Name, "装箱单") > 0 Then
- With Wb.Worksheets(i)
- n = .[a1].End(xlDown).Row
- arr = .Range(Cells(5, 2), Cells(n, 6))
- ReDim brr(1 To UBound(arr), 1 To 11)
- For j = 1 To UBound(brr)
- brr(j, 1) = Split(.[a1].Value, "：")(1)
- brr(j, 3) = Split(.[a2].Value, "：")(1)
- brr(j, 5) = Split(.[a3].Value, "：")(1)
- brr(j, 2) = .[f1]: brr(j, 4) = .[f2]: brr(j, 6) = .[f3]
- For k = 1 To UBound(arr, 2)
- brr(j, k + 6) = arr(j, k)
- Next
- Next
- End With
- End If
- Next
- nm = ThisWorkbook.Worksheets(1).[a65536].End(3).Row + 1
- ThisWorkbook.Worksheets(1).Cells(nm, 1).Resize(UBound(brr), UBound(brr, 2)) = brr
- Workbooks(myFile).Close False
-
- End If
- myFile = Dir
- Loop
-
- Application.ScreenUpdating = True
- MsgBox "汇总完成，请查看！", 64, "提示"
- End Sub
 汇总数据.rar
|