就剩下这么几段代码了。有兴趣的帮帮忙。谢谢！
谢谢之前帮忙的老师。就剩下这几段代码了。希望有人能帮忙注释一下。谢谢！！！
一、
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
三、
Vb code
Sub 筛选重复数据()
Dim i As Integer
Dim j As Integer
j = ActiveCell.Column
finalrow = Cells(65536, j).End(xlUp).Row
For i = 1 To finalrow
If Application.WorksheetFunction.CountIf(Columns(j), Cells(i, j)) > 1 Then
Cells(i, j).Interior.ColorIndex = 3
End If
Next i
End Sub
四、
VB code
Sub 按钮1_Click()
Dim arr, brr
arr = Sheet1.Range("A1").CurrentRegion
ReDim brr(1 To UBound(arr), 0)
For i = 5 To UBound(arr) Step 5
If arr(i, 1) = arr(i, 2) Then b = b + 1: brr(b, 0) = i
Next
If b = 0 Then MsgBox "没有相同的数据！", , "": Exit Sub
With Sheet2
.Rows.Clear
.[a1] = "数据相同的行号"
.[a2].Resize(b, 1) = brr
.Select
End With
End Sub
[最优解释]
VB code
Sub 按钮1_Click()
Dim arr, brr
arr = Sheet1.Range("A1").CurrentRegion '取数据
ReDim brr(1 To UBound(arr), 0) '设置 brr 大小
For i = 5 To UBound(arr) Step 5 '查找的是 5 10 15 20 ... 行的数据
If arr(i, 1) = arr(i, 2) Then b = b + 1: brr(b, 0) = i ’A 列 与 B 列相等则记录行号
Next
If b = 0 Then MsgBox "没有相同的数据！", , "": Exit Sub
With Sheet2
.Rows.Clear
.[a1] = "数据相同的行号"
.[a2].Resize(b, 1) = brr '标示出相等行的行号
.Select
End With
End Sub
Sub 筛选重复数据()
Dim i As Integer
Dim j As Integer
j = ActiveCell.Column '活动单元格所在的列号
finalrow = Cells(65536, j).End(xlUp).Row '活动单元格所在的最后一个单元格的行号
'将重复单元格用红色标出
For i = 1 To finalrow
If Application.WorksheetFunction.CountIf(Columns(j), Cells(i, j)) > 1 Then '单元格的值在本列中的个数，如果>1，说明有重复。用红色标出
Cells(i, j).Interior.ColorIndex = 3
End If
Next i
End Sub
