首页 > 代码库 > 拆分表格

拆分表格

 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").Value11         num2 = .Range("I1").Value12         num3 = .Range("J1").Value13         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) <> "作废" Then18                 If Not d.Exists(arr1(i, 1)) Then19                     Set d(arr1(i, 1)) = .Range("C" & num1 & ":F" & num1)20                 Else21                     Set d(arr1(i, 1)) = Union(d(arr1(i, 1)), .Range("C" & num1 + i - 1 & ":F" & num1 + i - 1))22                 End If23             End If24         Next25     End With26     With Worksheets("回执单")27         For Each k In d.keys28             h = .Cells(.Rows.Count, 5).End(xlUp).Row29             MsgBox ("h=" & h)30             Set rng = .Range("A" & (h - 9) & ":F" & h)31             rng.Copy32     End With33 End Sub

 

拆分表格