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
