|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Option Explicit
Sub TEST5()
Dim ar, br, cr, i&, j&, dic As Object
Dim strJoin$, wks As Worksheet, r1&, r2&
Set dic = CreateObject("Scripting.Dictionary")
For Each wks In Worksheets
If wks.Name <> "汇总" Then
With wks
ar = Range(.[A2], .Cells(Rows.Count, "C").End(xlUp)).Value
For i = 2 To UBound(ar)
strJoin = Join(Application.Index(ar, i))
dic(strJoin) = Application.Index(ar, i)
Next i
End With
End If
Next
ar = Application.Rept(dic.items, 1)
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
ReDim cr(1 To UBound(ar), 1 To UBound(ar, 2))
For i = 1 To UBound(ar)
If ar(i, 1) = "广州" Then
r2 = r2 + 1
For j = 1 To UBound(ar, 2)
cr(r2, j) = ar(i, j)
Next j
Else
r1 = r1 + 1
For j = 1 To UBound(ar, 2)
br(r1, j) = ar(i, j)
Next j
End If
Next i
[G8].CurrentRegion.Clear
[G8].Resize(r1, UBound(ar, 2)) = br
[J8].Resize(r2, UBound(ar, 2)) = cr
Set dic = Nothing
Beep
End Sub
|
评分
-
1
查看全部评分
-
|