當前位置:成語大全網 - 新華字典 - vba讀取excel遍歷文件指定數據

vba讀取excel遍歷文件指定數據

Excel文件格式壹致,匯總求和,其他需求自行變通容

匯總使用了字典

Public d

Sub 按鈕1_Click()

Application.ScreenUpdating = False

ActiveSheet.UsedRange.ClearContents

Cells(1, 1) = "編號"

Cells(1, 2) = "數量"

Set d = CreateObject("scripting.dictionary")

Getfd (ThisWorkbook.Path) 'ThisWorkbook.Path是當前代碼文件所在路徑,路徑名可以根據需求修改

Application.ScreenUpdating = True

If d.Count > 0 Then

ThisWorkbook.Sheets(1).[a2].Resize(d.Count) = WorksheetFunction.Transpose(d.keys)

ThisWorkbook.Sheets(1).[b2].Resize(d.Count) = WorksheetFunction.Transpose(d.items)

End If

End Sub

Sub Getfd(ByVal pth)

Set Fso = CreateObject("scripting.filesystemobject")

Set ff = Fso.getfolder(pth)

For Each f In ff.Files

Rem 具體提取哪類文件,還是需要根據文件擴展名進行處理

If InStr(Split(f.Name, ".")(UBound(Split(f.Name, "."))), "xl") > 0 Then

If f.Name <> ThisWorkbook.Name Then

Set wb = Workbooks.Open(f)

For Each sht In wb.Sheets

If WorksheetFunction.CountA(sht.UsedRange) > 1 Then

arr = sht.UsedRange

For j = 2 To UBound(arr)

d(arr(j, 1)) = d(arr(j, 1)) + arr(j, 2)

Next j

End If

Next sht

wb.Close False

End If

End If

Next f

For Each fd In ff.subfolders

Getfd (fd)

Next fd

End Sub