怎么用vba实现根据多个条件进行去重和计数

sdg1345

Sub aasd()
Dim dic As Object, brr(1 To 100, 1 To 4)
Set dic = CreateObject("scripting.dictionary")

With Worksheets("明细")
    r = .Cells(.Rows.Count, "a").End(xlUp).Row
    arr = .Range("a1").CurrentRegion
    m = 0
    For i = 2 To r
    If arr(i, 5) = "开放" Then
    arry1 = Array(arr(i, 1), arr(i, 2), arr(i, 3))
    arry = Join(arry1, "　")
        If Not dic.exists(arry) Then
            dic(arry) = 1
        Else
            dic(arry) = dic(arry) + 1
        End If
    End If
    Next i
    End With
Stop
With Worksheets("处理后")
    .Cells.ClearContents
    s = dic.keys
    s1 = dic.items
    For i = 0 To UBound(s)
        For j = 1 To 3
            brr(i + 1, j) = Split(s(i), "　")(j - 1)
            brr(i + 1, 4) = s1(i)
        Next j
    Next i
    .Cells(1, "a").Resize(1, 4) = Array("观众编码", "观众来源城市", "观众来源市区", "观看过的场次")
    .Cells(2, "a").Resize(UBound(brr), UBound(brr, 2)) = brr
End With
End Sub

10307951261

正需要，留个脚印，备查

cjc209

Sub 字典记录行号_条件去重统计()
    Dim Arr, 结果数组(), i As Long, k As Long, 关键字 As String, dic As Object
    tim = Timer
    Arr = Sheet1.[a1].CurrentRegion '原始数据装入数组
    Set 结果起始单元格 = Sheet1.[i2]
    ReDim 结果数组(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
    Set dic = CreateObject("scripting.dictionary")
    Set dic房间编号 = CreateObject("scripting.dictionary")
    For i = 2 To UBound(Arr, 1) '标题行开始
        关键字 = Arr(i, 1) & "|" & Arr(i, 2) & "|" & Arr(i, 3)
        If Arr(i, 5) = "开放" Then
            If Not dic.Exists(关键字) Then
                dic房间编号(关键字) = Arr(i, 4)
                k = k + 1
                dic(关键字) = k '记录关键字所在结果数组中的行号位置
                For j = 1 To UBound(Arr, 2) - 2 '循环多字段取值
                    结果数组(k, j) = Arr(i, j)
                Next
                结果数组(k, UBound(Arr, 2) - 1) = 1
            Else
                If Not "," & dic房间编号(关键字) & "," Like "*," & Arr(i, 4) & ",*" Then
                    dic房间编号(关键字) = dic房间编号(关键字) & "," & Arr(i, 4)
                    结果数组(dic(关键字), UBound(Arr, 2) - 1) = 结果数组(dic(关键字), UBound(Arr, 2) - 1) + 1 '循环多字段取值累加
                End If
            End If
        End If
    Next
    结果起始单元格.CurrentRegion.ClearContents
    结果起始单元格.Resize(k, UBound(Arr, 2) - 1) = 结果数组
    MsgBox "执行完毕!_用时:  " & Format(Timer - tim, "0.00") & "  秒"
End Sub

10307951261

cjc209 发表于 2022-4-28 18:25
Sub 字典记录行号_条件去重统计()
    Dim Arr, 结果数组(), i As Long, k As Long, 关键字 As String, di ...

大神，我想统计每个房间的消费金额怎么改代码 求助.rar (24.29 KB, 下载次数: 34)

2022-4-29 17:36 上传

点击文件名下载附件

薛定谔233

10307951261 发表于 2022-4-29 17:37
大神，我想统计每个房间的消费金额怎么改代码

汇总金额用11楼的代码

1. If Not dic.exists(arry) Then
   
2.             dic(arry) = arr(i,5)
   
3.         Else
   
4.             dic(arry) = dic(arry) + arr(i,5)
   
5.         End If

复制代码

10307951261

留个脚印学习

益母八珍丸

正在学习VBA,代码收藏了,好好学习.