求高手

18977971085

求高手写个代码，一键生成汇总合计里的汇总

不知道为什么

真实惜字如金啊，按什么维度合并？合并的数据是如何处理？把需求说详细点，更方便别人怎么帮助你

18977971085

不知道为什么 发表于 2018-6-18 16:40
真实惜字如金啊，按什么维度合并？合并的数据是如何处理？把需求说详细点，更方便别人怎么帮助你

就是按相同的施工部位，相同的日期，合并后求出方数的合计

18977971085

例如合计里面的例子

18977971085

自己弄好了

Sub 合计()
  Dim dic As Object
  Dim arr, brr()
  Dim i As Long
  Dim xh, n, m
Sheets("明细").Activate
  arr = Range("b1").CurrentRegion
Set dic = CreateObject("scripting.dictionary") '建立字典对象dic
ReDim brr(1 To UBound(arr), 1 To 12)
For i = 2 To UBound(arr)
   xh = arr(i, 3)
   If Not dic.exists(xh) Then
      n = n + 1
      dic(xh) = n
      brr(n, 1) = arr(i, 2)
      brr(n, 2) = arr(i, 3)
      brr(n, 3) = arr(i, 4)
      brr(n, 4) = arr(i, 5)
      brr(n, 5) = arr(i, 6)
      brr(n, 6) = arr(i, 10)
     Else
     m = dic(xh)
      brr(m, 6) = brr(m, 6) + arr(i, 10)
   
   End If
Next i
Sheets("合计").Activate
Columns("m:r").Clear
  Sheets("合计").Range("a3").Resize(dic.Count, 6) = brr
End Sub

18977971085

忘了，闪屏呢

Sub 合计()
Application.ScreenUpdating = False '关闭屏幕刷新
Application.Calculation = xlCalculationManual   '手动重算
Dim dic As Object
Dim arr, brr()
Dim i As Long
Dim xh, n, m
Sheets("明细").Activate
arr = Range("b1").CurrentRegion
Set dic = CreateObject("scripting.dictionary") '建立字典对象dic
ReDim brr(1 To UBound(arr), 1 To 12)
For i = 2 To UBound(arr)
   xh = arr(i, 3) '& arr(i, 3) & arr(i, 4) & arr(i, 5) & arr(i, 6)
   If Not dic.exists(xh) Then
      n = n + 1
      dic(xh) = n
      brr(n, 1) = arr(i, 2)
      brr(n, 2) = arr(i, 3)
      brr(n, 3) = arr(i, 4)
      brr(n, 4) = arr(i, 5)
      brr(n, 5) = arr(i, 6)
      brr(n, 6) = arr(i, 10)
     Else
     m = dic(xh)
      brr(m, 6) = brr(m, 6) + arr(i, 10)
     ' brr(m, 2) = brr(m, 2) + arr(i, 3)
   
   End If
Next i
  Application.Calculation = xlCalculationAutomatic    '自动重算
Sheets("合计").Activate
Columns("m:r").Clear
' Range("m2").Resize(dic.Count, 1) = Application.Transpose(dic.keys)
  Sheets("合计").Range("a3").Resize(dic.Count, 6) = brr

End Sub