|
Sub 拆分()
Application.ScreenUpdating = False
Dim ar As Variant
Dim i As Long, r As Long, rs As Long
Dim br()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
With Sheets("总表")
r = .Cells(Rows.Count, 9).End(xlUp).Row
ar = .Range("a1:j" & r)
End With
For Each sh In Sheets
dc(sh.Name) = ""
Next sh
For i = 3 To UBound(ar)
If Trim(ar(i, 9)) <> "" Then
If Trim(ar(i, 9)) <> "小计" Then
d(Trim(ar(i, 9))) = ""
End If
End If
Next i
For Each k In d.keys
n = 0
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
For i = 3 To UBound(ar)
If Trim(ar(i, 9)) = k Then
n = n + 1
For j = 1 To UBound(ar, 2)
br(n, j) = ar(i, j)
Next j
End If
Next i
If dc.exists(k) Then
With Sheets(k)
rs = .Cells(Rows.Count, 9).End(xlUp).Row
If rs >= 3 Then .Range("a3:p" & rs) = Empty
.[a3].Resize(n, UBound(br, 2)) = br
End With
Else
Sheets("非标设备").Copy after:=Sheets(Sheets.Count)
With ActiveSheet
.Name = k
rs = .Cells(Rows.Count, 9).End(xlUp).Row
If rs >= 3 Then .Range("a3:p" & rs) = Empty
.[a2] = "1)"
.[c2] = k
.[a3].Resize(n, UBound(br, 2)) = br
End With
End If
Next k
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub
|
|