数据汇总

淘气的萝卜

各位大佬，附件为检验数据的统计汇总，跪求VBA统计汇总程序，不甚感激！

edwin11891

可以不用VBA，两个报表函数的事，筛选月份在P1输入（空值则无筛选）：
O2：

1. =DROP(PIVOTBY(HSTACK(MATCH(M2:M6481,M2:M6481,),M2:M6481),K2:K6481,K2:K6481,COUNTA,0,1,,1,,IF(P1="",G2:G6481,MONTH(G2:G6481)=P1)),,1)

复制代码

O26：

1. =LET(t,DROP(GROUPBY(J2:J6481,J2:K6481,HSTACK(COUNTA,COUNTA),,,,IF(P1="",G2:G6481,MONTH(G2:G6481)=P1)),1),s,HSTACK(t,ROUND(100-CHOOSECOLS(t,3)/CHOOSECOLS(t,2)*100,2)),VSTACK({"加工分类","总数","不良数","合格率%"},s))

复制代码

淘气的萝卜

edwin11891 发表于 2024-12-4 11:31
可以不用VBA，两个报表函数的事，筛选月份在P1输入（空值则无筛选）：
O2：

感谢回复，能用VBA吗？函数粘贴复制有时会弄错

edwin11891

淘气的萝卜 发表于 2024-12-4 13:24
感谢回复，能用VBA吗？函数粘贴复制有时会弄错

VBA多年不用，生疏了，如果一定要用，建议到VBA板块求助。
BTW，如果函数会出错，VBA一样可能会出错。

淘气的萝卜

edwin11891 发表于 2024-12-4 14:22
VBA多年不用，生疏了，如果一定要用，建议到VBA板块求助。
BTW，如果函数会出错，VBA一样可能会出错。

谢谢回复，我没表达清楚，不是说函数会出错。因为没掌握这个函数的用法，在套用中会出错。你能附上函数的附件吗？学习下

edwin11891

淘气的萝卜 发表于 2024-12-4 15:26
谢谢回复，我没表达清楚，不是说函数会出错。因为没掌握这个函数的用法，在套用中会出错。你能附上函数的 ...

在附件，为便于复制使用，将公式修改了一下，指定了数据源（数据源范围也便于修改），公式复制到任何地方都不会出错。
如果硬要填充你自己模板内的单元格，提取数据最终输出结果中的指定数值即可，可用方法有TAKE、DROP、CHOOSEROWS、CHOOSECOLS等函数均可以随意组合提取。

edwin11891

淘气的萝卜 发表于 2024-12-4 15:26
谢谢回复，我没表达清楚，不是说函数会出错。因为没掌握这个函数的用法，在套用中会出错。你能附上函数的 ...

另外，你的查询表模板中的不良类型，跟实际类型数量、名称均不一致，是否有问题？你可以用
=TOROW(UNIQUE(来料检验明细表!K2:K6481)) 检查对比一下。
排除这个因素，完全按照你的查询表模板填空，也很简单。

淘气的萝卜

edwin11891 发表于 2024-12-4 16:15
在附件，为便于复制使用，将公式修改了一下，指定了数据源（数据源范围也便于修改），公式复制到任何地方 ...

收到，感谢！我学习下

quqiyuan

用vba做了一下，仅供参考，，，，
批次合格率理解不到楼主的意思，说是不合格的行跟总行数之间的比值，跟楼主数据有出入，其他数据我看没什么问题，请楼主核对，本来不合格项目还有的，其实可以用字典单独处理，后来看楼主都有列标题了，就用楼主列标题了。

quqiyuan

代码如下。。。
Sub test()
    Dim wb As Workbook, sht As Worksheet, sh As Worksheet
    Set wb = ThisWorkbook
    Set sht = wb.Sheets("来料检验明细表")
    Set sh = wb.Sheets("查询表")
    r = sh.Cells(Rows.Count, 1).End(3).Row - 5
    xm = sh.[d1]: d = sh.[f1]
    s = xm & "|" & d
    arr = sht.[a1].CurrentRegion
    ReDim brr(1 To 10000, 1 To 100)
    Set d = CreateObject("scripting.dictionary")
'    n = 0: m = 3
'    brr(1, 1) = "供应商名称": brr(1, 2) = "交付总数": brr(1, 3) = "不合格数"
    biaoti = sh.[a3:o3]
    For i = 4 To 12
        d(biaoti(1, i)) = i
    Next
    For i = 2 To UBound(arr)
        ss = arr(i, 3) & "|" & Month(arr(i, 7))
        If InStr(ss, s) Then
            hang = hang + 1
            zong = zong + arr(i, 6)
            If Not d.exists(arr(i, 13)) Then
                n = n + 1
                d(arr(i, 13)) = n
                brr(n, 1) = arr(i, 13)
            End If
            If arr(i, 11) <> Empty Then
                If d.exists(arr(i, 11)) Then
'                    m = m + 1
'                    d(arr(i, 11)) = m
'                    brr(1, m) = arr(i, 11)
                    y = d(arr(i, 11))
                End If
            End If
            x = d(arr(i, 13))
'            y = d(arr(i, 11))
            brr(x, 100) = brr(x, 100) + 1
            brr(x, 2) = brr(x, 2) + arr(i, 6)
            brr(x, 3) = brr(x, 3) + arr(i, 9)
            If y <> Empty Then brr(x, y) = brr(x, y) + arr(i, 9): y = Empty: brr(x, 99) = brr(x, 99) + 1
        End If
    Next
    For i = 1 To n
         brr(i, 13) = Format(1 - brr(i, 3) / brr(i, 2), "0.00%")
         brr(i, 14) = Format(1 - brr(i, 99) / brr(i, 100), "0.00%")
         brr(i, 15) = "=VLOOKUP(" & brr(i, 13) & ",{0,""E级"";0.8,""D级"";0.85,""C级"";0.9,""B级"";0.95,""A级""},2)"
    Next
    If n <= r Then
        sh.[a4].Resize(r, UBound(biaoti, 2)) = ""
        sh.[a4].Resize(n, UBound(biaoti, 2)) = brr
    Else
        sh.Cells(r + 4, 1).Resize(n - r).Insert xlShiftDown
        sh.[a4].Resize(r, UBound(biaoti, 2)) = ""
        sh.[a4].Resize(n, UBound(biaoti, 2)) = brr
    End If
    sh.[h1] = hang: sh.[j1] = zong
    Set d = Nothing
    Beep
End Sub