首页 > 代码库 > 拆分表格
拆分表格
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
拆分表格
声明:以上内容来自用户投稿及互联网公开渠道收集整理发布,本网站不拥有所有权,未作人工编辑处理,也不承担相关法律责任,若内容有误或涉及侵权可进行投诉: 投诉/举报 工作人员会在5个工作日内联系你,一经查实,本站将立刻删除涉嫌侵权内容。