|
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
- Sub 按钮2_Click()
- Application.ScreenUpdating = False
- Set d = CreateObject("scripting.dictionary")
- Set fso = CreateObject("scripting.filesystemobject")
- Set sh = ActiveSheet
- For Each f In fso.getfolder(ThisWorkbook.Path).Files
- If InStr(f.Name, "统计重复") = 0 Then
- brr = Split(f.Name, "-")
- str1 = brr(1) & "-" & brr(2) & "-" & brr(3)
- With Workbooks.Open(f)
- arr = .Sheets(1).UsedRange
- For j = 2 To UBound(arr)
- If Len(arr(j, 5)) > 10 Then
- d(arr(j, 5)) = d(arr(j, 5)) & "@@" & brr(0) & "##" & str1 & "##" & arr(j, 8) & "##" & arr(j, 4) & "##" & arr(j, 5) & "##" & arr(j, 7)
- End If
- Next j
- .Close
- End With
- End If
- Next f
- sh.Columns("a:i").Clear
- a = 1
- For j = 0 To d.Count - 1
- brr = Split(d.items()(j), "@@")
- If UBound(brr) > 1 Then
- For i = 1 To UBound(brr)
- sh.Cells(a, 1).Resize(1, 6) = Split(brr(i), "##")
- a = a + 1
- Next i
- End If
- Next j
- Application.ScreenUpdating = True
- End Sub
复制代码 |
|