|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
本帖最后由 网海遨游 于 2019-11-5 16:48 编辑
没用你的代码,是这样吗?
Sub 相同单元格求和写入()
Dim i, mf$, mp$, brr(), arr(), srr(1 To 50000)
mp = ThisWorkbook.path & "\" '获取路径
mf = Dir(mp & "*.xl*") '取得文件名
Do
If mf <> ThisWorkbook.Name Then '如果需要打开的工作薄名〈〉有代码工作薄名,就……
i = i + 1 '累加、计数
ReDim Preserve arr(1 To i)
Set dk = Workbooks.Open(mp & mf) '打开
arr(i) = dk.Sheets("小学").[e3:e478]
dk.Close False '关闭时不保存
' ReDim Preserve brr(1 To i)
' brr(i) = Split(mf, ".")(0) '校名
For j = 1 To UBound(arr(1))
If i = 1 Then
srr(j) = Val(arr(i)(j, 1))
Else
srr(j) = srr(j) + Val(arr(i)(j, 1))
End If
Next j
End If
mf = Dir
Loop While mf <> "" '因为不知道有多少个文件,用Do循环
ThisWorkbook.Sheets("小学").[e3].Resize(UBound(srr)).ClearContents
ThisWorkbook.Sheets("小学").[e3].Resize(UBound(srr)) = Application.Transpose(srr)
End Sub
|
评分
-
1
查看全部评分
-
|