合计B至F列相同对应M、N列数值

gwjkkkkk

Sub TEST()
    Dim arr, i&, j&, R&, dic As Object, iPosRow&, vKey
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheets(1)
      arr = Range(.[A2], .Cells(Rows.Count, "N").End(xlUp))
    End With
    For i = 1 To UBound(arr)
      vKey = arr(i, 3) & arr(i, 4)
      If Not dic.Exists(vKey) Then
         R = R + 1
            arr(R, 1) = R
            For j = 2 To UBound(arr, 2)
               arr(R, j) = arr(i, j)
            Next j
            dic(vKey) = R
         Else
         iPosRow& = dic(vKey)
         For j = 12 To 14
            arr(iPosRow, j) = arr(iPosRow, j) + arr(i, j)
         Next j
      End If
    Next i
    Range("A2:N1000").Clear
    [A2].Resize(R, UBound(arr, 2)) = arr
    Set dic = Nothing
    With Range("A1", Cells(Rows.Count, "N").End(xlUp))
        '.HorizontalAlignment = xlCenter
        .Borders.LineStyle = xlContinuous
        .Rows(1).Font.Bold = True
        .EntireColumn.AutoFit
        .EntireRow.AutoFit
    End With
    Application.ScreenUpdating = True
End Sub

gwjkkkkk

请楼主参考附件。。。

zhurq9876

3190496160 发表于 2022-12-7 10:31
使用excel表格的习惯太差了，整个页面都设置了边框线，会拖慢代码运行的速度的，

谢谢。还有一个汇总B列单元格格式能不能设置成文本格式的，

3190496160

zhurq9876 发表于 2022-12-7 11:05
谢谢。还有一个汇总B列单元格格式能不能设置成文本格式的，

这句
.UsedRange.Offset(1).Clear
修改为
.UsedRange.Offset(1)=empty
然后录制一段设置单元格格式的宏加在这句的下面即可