利用VBA字典根据图片所示分类汇总

LOYOTO

笨鸟飞不高

123.zip (16.7 KB, 下载次数: 26)

2022-12-15 14:15 上传

点击文件名下载附件

small_small

1. Sub 字典提取数据()
   
2.     Dim arr, brr(1 To 1000, 1 To 4), d, k, n, m
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Range("a1").CurrentRegion
   
5.     For k = 2 To UBound(arr)
   
6.         If arr(k, 5) = "不符合" Then
   
7.             If d.exists(arr(k, 1)) = False Then
   
8.                 n = n + 1
   
9.                 d(arr(k, 1)) = n
   
10.                 brr(n, 1) = arr(k, 1)
    
11.                 brr(n, 2) = "不符合"
    
12.                 brr(n, 3) = arr(k, 2)
    
13.                 brr(n, 4) = arr(k, 6)
    
14.             Else
    
15.                 m = d(arr(k, 1))
    
16.                 If InStr(brr(m, 3), arr(k, 2)) = 0 Then
    
17.                     brr(m, 3) = brr(m, 3) & "," & arr(k, 2)
    
18.                 End If
    
19.                 If InStr(brr(m, 4), arr(k, 6)) = 0 Then
    
20.                     brr(m, 4) = brr(m, 4) & "," & arr(k, 6)
    
21.                 End If
    
22.             End If
    
23.         End If
    
24.     Next k
    
25.     Range("h2").Resize(n, 4) = brr
    
26. End Sub

复制代码

蓝桥玄霜

批次的例子：

ykcbf1100

参与一下。

fzxba

123.rar (16.41 KB, 下载次数: 21)

2022-12-15 14:21 上传

点击文件名下载附件

grf1973

参与一下。需要对质量问题去重处理。

KAI19

Sub text()
   Dim i%, j%, arr, brr(1 To 10, 1 To 4), d As Object
   Set d = CreateObject("scripting.dictionary")
   arr = Range("a1").CurrentRegion
   For i = 2 To UBound(arr)
     d(arr(i, 1)) = ""
   Next
   For j = 0 To d.Count - 1
     n = n + 1
     For i = 2 To UBound(arr)
        If arr(i, 1) = d.Keys()(j) And arr(i, 5) = "不符合" Then
           brr(n, 1) = d.Keys()(j)
           brr(n, 2) = "不符合"
           brr(n, 3) = arr(i, 2) & "," & brr(n, 3)
           If InStr(brr(n, 4), arr(i, 6)) = 0 Then
              brr(n, 4) = arr(i, 6) & "," & brr(n, 4)
           End If
        End If
     Next
   Next
   Range("h2").Resize(d.Count, 4) = brr
   Set d = Nothing: Erase arr: Erase brr
End Sub

grf1973

一个字典。

grf1973

最通用的做法。