统计数量和计算金额合计

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, i&, j&, r&, dic As Object, iPosRow&
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    With [A1].CurrentRegion
        ar = .Value
        ReDim Preserve ar(1 To UBound(ar), 1 To UBound(ar, 2) + 1)
        r = 1
        For i = 2 To UBound(ar)
            If Cells(i, 1).Interior.ColorIndex <> -4142 Then
                If Not dic.exists(ar(i, 2)) Then
                    r = r + 1
                    For j = 1 To UBound(ar, 2)
                        ar(r, j) = ar(i, j)
                    Next j
                    ar(r, UBound(ar, 2)) = 1
                    dic(ar(i, 2)) = r
                Else
                    iPosRow = dic(ar(i, 2))
                    ar(iPosRow, 4) = ar(iPosRow, 4) + ar(i, 4)
                    ar(iPosRow, UBound(ar, 2)) = ar(iPosRow, UBound(ar, 2)) + 1
                End If
            End If
        Next i
    End With
    For i = 2 To r
        ar(i, 2) = ar(i, 2) & "(" & ar(i, UBound(ar, 2)) & ")"
    Next i
   
    Columns("H:L").Clear
    With [H1].Resize(r, UBound(ar, 2) - 1)
        .Value = ar
        .Font.Size = 10
        .HorizontalAlignment = xlCenter
        .Borders.LineStyle = xlContinuous
        .EntireColumn.AutoFit
        .EntireRow.AutoFit
    End With
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

按涂色进行统计。。。

xing_chen

杨建营 发表于 2023-3-11 23:15
请楼主参考。

谢谢老师！

xing_chen

lushang2018 发表于 2023-3-11 23:19
Sub 测试()  ''答题专用套路--by:学习使我快乐
    Dim i, j, k, m, n, arr, brr, crr, drr
    Dim sht  ...

谢谢老师！

xing_chen

shiruiqiang 发表于 2023-3-12 07:49
字典有了，直接输出就行

谢谢老师！

xing_chen

gwjkkkkk 发表于 2023-3-12 10:28
按涂色进行统计。。。

谢谢老师！运行顺畅，收藏了。

xing_chen

shiruiqiang 发表于 2023-3-12 07:49
字典有了，直接输出就行

老师！为更好表明我的意图：即只对符号条件的字符，适用字典，其它的不用。我重新注释了表格。方便帮忙看看，我是这意思

准提部林

xing_chen 发表于 2023-3-12 11:05
老师！为更好表明我的意图：即只对符号条件的字符，适用字典，其它的不用。我重新注释了表格。方便帮忙看 ...

老是這樣子會問, 一直問不完!!!

1) 指定合計的項目只有一種?? 有多種又如何??  在哪個位置可以取得指定項目??
2) 指定項目, 若非連續(即分散)又如何??
3) 指定項目只有一行, "列6"..次數如何標?
4) 結果覆蓋原位置?   放在其它位置???

xing_chen

准提部林 发表于 2023-3-12 11:16
老是這樣子會問, 一直問不完!!!

1) 指定合計的項目只有一種?? 有多種又如何??  在哪個位置可以取得指 ...

谢谢老师的回复！
1只指定一个项目，因为相对其它，此项目不重要，只需知道笔数和合计金额则可，所以统计一下，只记1条，其它删除；
2.此表格我已排序，所以不存在分散
3.只记1条，指定在与需统计项目的第1条平行。汇总后，多余的删除。否则表格的列总数与原表的列总数不一致。
3.位置单独放置1列，便于整个工作簿的汇总，不因加入后缀（笔数）而导致名称过多。

准提部林

xing_chen 发表于 2023-3-12 11:38
谢谢老师的回复！
1只指定一个项目，因为相对其它，此项目不重要，只需知道笔数和合计金额则可，所以统 ...

只指定一個項目, 且已排序,
應用不到字典~~