|
- Sub 汇总数据()
- Dim sPath As String, vData As Variant, nRow As Integer, nCol As Integer, sFile As String
- Dim vFill As Variant, nFill As Variant
-
- Application.ScreenUpdating = False
- nRow = 13
- sPath = "d:\提取"
- sFile = Dir(sPath & "*.xlsx")
- ReDim vFill(1 To 9, 0)
- Do While sFile <> ""
- With Workbooks.Open(sPath & sFile)
- vData = .Sheets(1).UsedRange.Value
- .Close False
- End With
- nFill = nFill + 1
- ReDim Preserve vFill(1 To 9, 1 To nFill)
- For nCol = 1 To 9
- If nCol <= UBound(vData, 2) Then vFill(nCol, nFill) = vData(nCol, nRow)
- Next
- sFile = Dir
- Loop
- With Sheet1
- .UsedRange.ClearContents
- If nFill > 0 Then .[A1:I1].Resize(nFill) = Application.WorksheetFunction.Transpose(vFill)
- End With
- Application.ScreenUpdating = True
- End Sub
复制代码 |
|