|
代码如下。。。
Sub 字典嵌套字典拆分2() '先建一个模板工作表,把表头复制过来,同时设置好页面格式
Dim dic As Object, i%, Arr, sh As Worksheet, sht As Worksheet, k, kk
Dim key As String, Brr, R%, j%
Set dic = CreateObject("scripting.dictionary")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For Each sh In Sheets
If sh.Name <> "明细表" And sh.Name <> "模板" Then
sh.Delete
End If
Next sh
Arr = Sheets("明细表").Range("A3").CurrentRegion
For i = 4 To UBound(Arr)
key = Arr(i, 8)
If Not dic.Exists(key) Then
Set dic(key) = CreateObject("scripting.dictionary")
End If
dic(key)(i) = ""
Next i
Set sht = Sheets("模板")
For Each k In dic.keys
R = 0
ReDim Brr(1 To 1000, 1 To 8)
sht.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = k
For Each kk In dic(k).keys
R = R + 1
For j = 1 To 8
Brr(R, j) = Arr(kk, j)
Next
Next
ActiveSheet.Range("A4").Resize(R, 8) = Brr
ActiveSheet.Range("A4").Resize(R, 8).Borders.LineStyle = 1
Next k
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
|
|