求大神VBA解决30万条数据的超难问题

microyip

andyleeq 发表于 2018-8-29 10:39
大侠，我自己写了代码，但太粗，效率低，30万件记录下来，就卡得一个小时硬是没算出来。。。。：（

谢 ...

就是没看见有任何代码，何来说太粗、效率低？明明就是伸手等代码嘛

zhenghui13

我是来看30W行记录文件会有多大.

lsdongjh

忽略 中间过程，告知 最后 想要的结果样式

andyleeq

大侠，报表出来这个（以下是003款为例，选择“003款”就出下面的报表

andyleeq

lsdongjh 发表于 2018-8-29 12:39
忽略 中间过程，告知 最后 想要的结果样式

就在楼上，报表的图片，谢谢

weisilisid

此类问题应该用SQL解决 怎么非得跑这用VBA 处理？

香川群子

先写出统计部分，用数组做，很简单。
前提条件，单号0-9999，款号0-999
Sub test()
    ar = [a1].CurrentRegion
    m = UBound(ar)
    ReDim a(1, 999), b(2, 9999), x&(99) 'a款/b单
    For i = 3 To m
        s = ar(i, 1) '单号
        t = ar(i, 2) '款号
        n = ar(i, 3) '数量
        
        If a(0, t) = 0 Then a(1, t) = x
        k = a(0, t) + 1: a(0, t) = k: a(1, t)(k) = s '款号内写入单号
        
        If b(0, s) = 0 Then b(1, s) = x: b(2, s) = x
        k = b(0, s) + 1: b(0, s) = k: b(1, s)(k) = t: b(2, s)(k) = n '单号内写入款号 并记录数量
    Next
   
    t1 = 3
    k = a(0, t1)
    ReDim br(k, 999)
    For i = 1 To k '遍历同款各单
        s = a(1, t1)(i) '读取单号
        br(i, 0) = b(0, s) '同款各单连带款个数
        For j = 1 To b(0, s)
            t = b(1, s)(j) '同款各单连带款
            n = b(2, s)(j) '同款各单连带款数量
            br(i, t) = n
            br(0, t) = br(0, t) + 1 '同款各单连带款次数统计
        Next
    Next
    Stop
End Sub

香川群子

用数组算的。没有使用字典。

香川群子

Sub test() 'by kagawa 2018/8/30
   
    tms = Timer '计时开始
   
    ar = Sheet1.[a1].CurrentRegion '读取ABC列数据到数组ar（第3行开始为订单数据）
    m = UBound(ar) '数据行数m
   
    ReDim a(1, 999), b(2, 9999), c&(999, 9999), x&(99) 'a款对应单号/b单号对应款号/c款单关联重复记录/x记录 的数组
   
    For i = 3 To m '第3行开始遍历
        t = ar(i, 1) '单号1-9999
        s = ar(i, 2) '款号1-999
        n = ar(i, 3) '数量
        
        If a(0, s) = 0 Then a(1, s) = x '记录款号对应单号
        If c(s, t) = 0 Then k = a(0, s) + 1: a(0, s) = k: a(1, s)(k) = t '款号内写入单号（去除同单同款重复）
        
        If b(0, t) = 0 Then b(1, t) = x: b(2, t) = x '记录单号对应款号、以及数量
        If c(s, t) = 0 Then '(无同单同款重复时)
            c(s, t) = 1 '标记款号对应单号 检查是否重复
            k = b(0, t) + 1: b(0, t) = k
            b(1, t)(k) = s: b(2, t)(k) = b(2, t)(k) + n '单号内写入款号 并记录数量(无同单同款重复时)
        Else '同单有同款重复时
            For k = 1 To b(0, t) '重复时遍历检查相同款
                If b(1, t)(k) = Val(s) Then b(2, t)(k) = b(2, t)(k) + n: Exit For '同单同款重复时的数量累计
            Next
        End If
    Next
   
    Sheet2.Activate
    s1 = [a2] '查询A2单元格中指定款号
    k = a(0, s1) '该款连单数
    If k = 0 Then MsgBox Format(Timer - tms, "0.000s") & vbCr & Format(s1, "000") & " 该款没有订单记录": Exit Sub
   
    ReDim br(-2 To k, -2 To 999) '连单/款 二维表统计(对应楼主表三)
    br(0, 0) = "单号/款号": br(-1, 0) = "连单次数": br(-2, 0) = "数量合计": br(0, -1) = "连单款数"
    For i = 1 To k '遍历同款各单 s= 5 1008 10 11 12 13
        t = a(1, s1)(i) '读取单号
        br(i, 0) = t '同款各单
        br(i, -1) = b(0, t) '同款各单连带款个数 s=5 t= 30 184 71 146 232 3
        For j = 1 To b(0, t)
            s = b(1, t)(j) '同款各单连带款
            n = b(2, t)(j) '同款各单连带款数量
            
            br(i, s) = br(i, s) + n
            br(-2, s) = br(-2, s) + n '同款各单连带款数量统计
            br(-1, s) = br(-1, s) + 1 '同款各单连带款次数统计
        Next
    Next
   
    [b2] = br(-2, s1) '销量=该款总销量 18
    [c2] = br(-1, s1) '销售单数=连单数 6
    ks = k '销售单数=连单数 6
    For i = 1 To k
        If br(i, -1) = 1 Then ts = ts + 1 '同款连单仅同款的单数
    Next
    [d2] = ks - ts '同单数(排除同款连单仅同款的单数)=6-2=4
    [e2] = (ks - ts) / ks '同单率
   
    ReDim cr(999, 2) '最终输出结果的数组cr
    k = 0
    For j = 1 To 999 '遍历表三统计表 汇总指定款号以外的连单、对应各个款的连单次数
        If br(-1, j) Then
            If j <> s1 Then
                cr(k, 0) = j: cr(k, 1) = br(-1, j): cr(k, 2) = br(-1, j) / ks: k = k + 1
                For i = -2 To ks
                    br(i, k) = br(i, j)
                Next
                br(0, k) = j
            Else
                For i = -2 To ks
                    br(i, -2) = br(i, j)
                Next
                br(0, -2) = j
            End If
        End If
    Next
   
    [a4].CurrentRegion.Offset(1).Clear '清空输出区域
    [a5].Resize(k, 3) = cr '输出结果
    [a5].Resize(k, 3).Sort [b5], 2, , , , , , 2 '结果排序
    [a5].Resize(k, 3).Borders.LineStyle = 1
    [a5].Resize(k).NumberFormatLocal = "000" '款号的输出格式显示前导0
   
    MsgBox Format(Timer - tms, "0.000s") & vbCr & "同单款号 " & k & " 个"
   
    [g4].CurrentRegion.Clear
    [g4].Resize(ks + 3, k + 3) = br
    [g4].Resize(ks + 3, k + 3).Borders.LineStyle = 1
End Sub

lsdongjh

用SQL的方法 计算.rar (36.57 KB, 下载次数: 24)

2018-8-30 14:15 上传

点击文件名下载附件