|
楼主 |
发表于 2018-1-21 10:54
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
已解决,先提取包含特定字符的文件名。
不知下面代码是否还能优化?
Sub 取数()
Dim arr, i, p$, sh As Worksheet, f, str
tt = MsgBox("参与取数的文件必须与本工作薄处于同一文件夹下,否则,无法取数!" & Chr(10) & Chr(10) & _
"是否继续?", vbQuestion + vbYesNo, "提示")
For Each f In CreateObject("scripting.FileSystemObject").GetFolder(ThisWorkbook.Path).Files
If f Like "*[年]*.xls" Then str = str & IIf(str = "", "", ";") & f
Next
a = Replace(Replace(str, ".xls", ""), ThisWorkbook.Path & "\", "")
p = ThisWorkbook.Path & "\" & a & ".xls"
With GetObject(p)
n = .Worksheets.Count
ReDim arr(1 To n, 1 To 36)
For Each sh In .Worksheets
With sh
If sh.Name Like "*日" Then
i = i + 1
arr(i, 1) = .[a3]
arr(i, 2) = .[e55]
arr(i, 3) = .[e56]
arr(i, 4) = .[e57]
arr(i, 5) = .[e58]
arr(i, 6) = .[e59]
arr(i, 7) = .[e60]
arr(i, 8) = .[e61]
arr(i, 9) = .[e62]
arr(i, 10) = .[e63]
arr(i, 11) = .[e64]
arr(i, 12) = .[e65]
arr(i, 13) = .[e66]
arr(i, 14) = .[e67]
arr(i, 15) = .[e68]
arr(i, 16) = .[e69]
arr(i, 17) = .[e70]
arr(i, 18) = .[e71]
arr(i, 19) = .[e72]
arr(i, 20) = .[e39]
arr(i, 21) = .[e40]
arr(i, 22) = .[e41]
arr(i, 23) = .[e42]
arr(i, 24) = .[e43]
arr(i, 25) = .[e44]
arr(i, 26) = .[e45]
arr(i, 27) = .[e46]
arr(i, 28) = .[e48]
arr(i, 29) = .[e49]
arr(i, 30) = .[e50]
arr(i, 31) = .[e51]
arr(i, 32) = .[e52]
arr(i, 33) = .[k72]
arr(i, 34) = .[l72]
arr(i, 35) = .[m72]
arr(i, 36) = .[n72]
End If
End With
Next
.Close 0
End With
With Sheet2
Sheet2.Range("A3:AX34").ClearContents
.[a3].Resize(UBound(arr), 36) = arr
Range("a" & i + 4) = "合计"
Range("b" & i + 4 & ":aj" & i + 4).Formula = "=sum(b4:b" & i + 1 & ")"
End With
End Sub |
|