求助VBA取最大及求和（可能有些难度）

dailj

        原始数据说明：
        B列无规则，处理时简单连接它就好
        C列是长度相等的一个或多个用逗号隔开的字符，一般不超20个
        D列是日期
        E列是数值
       
       
        生成最终结果，如右上表：（附件样本里）
步骤1将B列与C列每一个字符串连接，如B1C0001,B12C000105,B12C000106
        依次放入G列，各值分别等于E列÷C列字符串的个数,如附件1
步骤2求新字符串对应的最大日期
步骤3求新字符串对应的值的合计，等于E列的值说明正确
        附件1只是说明过程，可省略，只要最终结果即可
步骤4原始数据会不断增加，优化执行效率到最佳（超过3万条）
        增加只刷新新数据的按钮，和刷新全部数据的按钮。

鄂龙蒙

合并新字符：日期不同合并后算那个日期？

dailj

鄂龙蒙 发表于 2022-11-26 16:23
合并新字符：日期不同合并后算那个日期？

合并后算大的日期

3190496160

Sub 取数()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object
Dim br()
Set d = CreateObject("scripting.dictionary")
With Sheet1
    r = .Cells(Rows.Count, 2).End(xlUp).Row
    ar = .Range("a1:e" & r)
    ReDim br(1 To 100000, 1 To 3)
    For i = 2 To UBound(ar)
        If Trim(ar(i, 2)) <> "" Then
            If InStr(ar(i, 3), ",") = 0 Then
                zf = ar(i, 2) & ar(i, 3)
                t = d(zf)
                If t = "" Then
                    k = k + 1
                    d(zf) = k
                    t = k
                    br(k, 1) = zf
                End If
                br(t, 3) = br(t, 3) + ar(i, 5)
                br(t, 2) = ar(i, 4)
            ElseIf InStr(ar(i, 3), ",") > 0 Then
                rr = Split(ar(i, 3), ",")
                sl = UBound(rr) + 1
                For s = 0 To UBound(rr)
                    zf = ar(i, 2) & rr(s)
                    t = d(zf)
                    If t = "" Then
                        k = k + 1
                        d(zf) = k
                        t = k
                        br(k, 1) = zf
                    End If
                    br(t, 2) = ar(i, 4)
                    br(t, 3) = br(t, 3) + (ar(i, 5) / sl)
                Next s
            End If
        End If
    Next i
    r = .Cells(Rows.Count, 7).End(xlUp).Row
    .Range("g2:i" & rs + 1).Borders.LineStyle = 0
    .Range("g2:i" & rs + 1) = Empty
    .[g2].Resize(k, UBound(br, 2)) = br
    .[g2].Resize(k, UBound(br, 2)).Borders.LineStyle = 1
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

样本1.rar (20.03 KB, 下载次数: 12)

2022-11-26 17:09 上传

点击文件名下载附件

dailj

3190496160 发表于 2022-11-26 17:09

大佬辛苦！我把“结果”这个工作表内容清空，运行完，显示OK，一片空白啊。我现在用的是WPS 2019版本运行不出来结果，晚上回家用Excel2007试试

3190496160

dailj 发表于 2022-11-26 17:32
大佬辛苦！我把“结果”这个工作表内容清空，运行完，显示OK，一片空白啊。我现在用的是WPS 2019版本运行 ...

结果表是测试代码用的，最终结果还是在sheet1中

dailj

3190496160 发表于 2022-11-26 17:35
结果表是测试代码用的，最终结果还是在sheet1中

哦哦那不好意思，我到家再试下

dailj

3190496160 发表于 2022-11-26 17:35
结果表是测试代码用的，最终结果还是在sheet1中

大佬辛苦！好厉害！

dailj

3190496160 发表于 2022-11-26 17:09

大佬，如果这个最大日期不是在最后一行，有办法取日期最大值吗？如果要取最大值，会不会影响运行效率？