拆分表格

 1 Sub 发票回执单()
 2     Dim num1%, num2%, num3%, h%
 3     Dim arr1, arr2
 4     Dim rng As Range
 5     Dim d As Object
 6     Application.ScreenUpdating = False
 7     Application.DisplayAlerts = False
 8     Set d = CreateObject("scripting.dictionary")
 9     With Worksheets("发票登记表")
10         num1 = .Range("H1").Value
11         num2 = .Range("I1").Value
12         num3 = .Range("J1").Value
13         MsgBox (num3)
14         arr1 = .Range("B" & num1 & ":B" & num2)
15         arr2 = .Range("G" & num1 & ":G" & num2)
16         For i = 1 To UBound(arr1)
17             If arr2(i, 1) <> "作废" Then
18                 If Not d.Exists(arr1(i, 1)) Then
19                     Set d(arr1(i, 1)) = .Range("C" & num1 & ":F" & num1)
20                 Else
21                     Set d(arr1(i, 1)) = Union(d(arr1(i, 1)), .Range("C" & num1 + i - 1 & ":F" & num1 + i - 1))
22                 End If
23             End If
24         Next
25     End With
26     With Worksheets("回执单")
27         For Each k In d.keys
28             h = .Cells(.Rows.Count, 5).End(xlUp).Row
29             MsgBox ("h=" & h)
30             Set rng = .Range("A" & (h - 9) & ":F" & h)
31             ‘rng.Copy
32     End With
33 End Sub