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
时间: 2024-10-31 05:05:13