|
|
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False '关闭屏幕刷新
Application.DisplayAlerts = False '关闭提醒
Dim i, ii, x, y, shc, arr1()
Dim dic1 As Object, dic2 As Object
shc = Worksheets.Count - 2 '- 1 表示不汇总工作薄中最后1张表【注意修改参数，如修改为-3，表示表示不汇总工作薄中最后3张表】
Set dic1 = CreateObject("scripting.dictionary")
Set dic2 = CreateObject("scripting.dictionary")
For i = 1 To shc
With Sheets(i)
x = .Range("AX65536").End(3).Row '条件所在列【注意修改参数】
arr1 = .Range("AX5:AZ" & x).Value '【注意修改参数】
For ii = 1 To x - 4
If Not dic1.exists(arr1(ii, 1)) Then '如果编号不在字典里就加到字典里,
dic1(arr1(ii, 1)) = arr1(ii, 2) '用量放到字典key的相应item里
dic2(arr1(ii, 1)) = arr1(ii, 3) '这个字典dic2的item里放数里
Else
dic1(arr1(ii, 1)) = dic1(arr1(ii, 1)) + arr1(ii, 2)'如果编号已经存在,则用量叠加
dic2(arr1(ii, 1)) = dic2(arr1(ii, 1)) + arr1(ii, 3)'数量叠加
End If
Next
End With
Next
Range("B4:C200").ClearContents 'H3:I65536")表示数据存放在H3:I列【注意修改参数】
Range("B4").Resize(dic1.Count).Value = Application.Transpose(dic1.keys)'取出字典里的keys即编号【注意修改参数】
Range("C4").Resize(dic1.Count).Value = Application.Transpose(dic1.items) '取出用量【注意修改参数】
Range("H4").Resize(dic1.Count).Value = Application.Transpose(dic2.items) '取出数量【注意修改参数】
Erase arr1
dic1.RemoveAll
dic2.RemoveAll
End Sub
问题:请求将 shc = Worksheets.Count - 1 修改为排除指定的表和隐藏的表
类似如:If Sh.Name = "计算稿" Or Sh.Name = "钢结构材料汇总及价格分析表" Or _
Sh.Name = "钢结构计价表" Or Sh.Name = "哈密除税价" Or Sh.Visible = False Then |
|
