怎么没人解决这两段稍微长一点的代码呢?
继续把没解决代码发上来,希望有人帮忙注释一下。谢谢~~我等阿等啊等。
一、
VB code
Sub Macro1()
Dim MyPath$, MyName$, sh As Worksheet, arr, i&, m&, lr&
Set sh = ActiveSheet
MyPath = ThisWorkbook.Path & "\"
MyName = Dir$(MyPath & "*.xls")
Application.ScreenUpdating = False
sh.UsedRange.Offset(7).Clear
Do While MyName <> ""
If MyName <> ThisWorkbook.Name Then
m = m + 1
With GetObject(MyPath & MyName)
If m = 1 Then
.Sheets("汇总").UsedRange.Offset(7).Copy sh.[a8]
lr = .Sheets("汇总").[a65536].End(xlUp).Row - 1
Else
arr = .Sheets("汇总").UsedRange
With sh
For j = 3 To UBound(arr, 2)
If .Cells(8, j).HasFormula = False Then
For i = 8 To lr
If Len(arr(i, j)) Then .Cells(i, j) = .Cells(i, j) + arr(i, j)
Next
End If
Next
End With
End If
.Close False
End With
End If
MyName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "ok"
End Sub
二、
VB code
Sub chaifen()
Dim arr, brr(), d
Application.ScreenUpdating = False
Set d = CreateObject("scripting.dictionary")
arr = Sheet1.Range("a1:k" & Sheet1.[a65536].End(3).Row)
For i = 2 To UBound(arr)
If Not d.exists(arr(i, 11)) Then
d(arr(i, 11)) = i
Else
d(arr(i, 11)) = d(arr(i, 11)) & "," & i
End If
Next
k = d.keys
For i = 0 To d.Count - 1
t = Split(d(k(i)), ",")
ReDim brr(1 To UBound(t) + 2, 1 To 11)
m = 1
For n = 1 To 11
brr(m, n) = arr(1, n)
Next
For j = 0 To UBound(t)
m = m + 1
For n = 1 To 11
brr(m, n) = arr(t(j), n)
Next
Next
With Sheets.Add(after:=Sheets(Sheets.Count))
.Columns(1).NumberFormatLocal = "@"
.Columns(3).NumberFormatLocal = "@"
.[a1].Resize(m, 11) = brr
.Name = k(i)
End With
Next
Set d = Nothing
Application.ScreenUpdating = True
Sheet1.Select
End Sub
[解决办法]
真不知道你从哪里找的代码,看的头晕脑胀。第二段不是很清楚,因为看不下去了。
'做一个表,将指定目录下的所有XLS文件的"汇总表"数据汇总到一个表中Sub Macro1() Dim MyPath$, MyName$, sh As Worksheet, arr, i&, m&, lr& Set sh = ActiveSheet MyPath = ThisWorkbook.Path & "\" MyName = Dir$(MyPath & "*.xls") '查找XLS文件 Application.ScreenUpdating = False '禁止屏幕刷新 sh.UsedRange.Offset(7).Clear Do While MyName <> "" If MyName <> ThisWorkbook.Name Then '对除本文件以外的XLS进行汇总 m = m + 1 '文件个数 With GetObject(MyPath & MyName) If m = 1 Then '第一个文件直接取数据"汇总"表中的UsedRange.Offset(7)的值到当前工作表的第八行开始的区域 .Sheets("汇总").UsedRange.Offset(7).Copy sh.[a8] lr = .Sheets("汇总").[a65536].End(xlUp).Row - 1 '工作表A列最后一行的行号 Else arr = .Sheets(j E