VBA求助，去重后，查询满足条件的值，并统计数量！

king38425

将表中B列的订单类型提取在E列显示(去重)，再以E列的值去找C列相应对的值(输入人)，再统计同一个人出现的次数在F列显示，请高手指教，谢谢，在线等！

mmx1122

select 订单类型，输入者，count(输入者) as 次数 from 表名

melville

代码如下

1. Sub tt()
   
2. Dim d1 As Object
   
3. Dim arr, brr
   
4. Dim i As Long
   
5. Dim j, k As Integer
   
6. Dim s As String
   
7. 
   
8. Application.ScreenUpdating = False
   
9. Application.DisplayAlerts = False
   
10. 
    
11.     Set d1 = CreateObject("Scripting.Dictionary")
    
12.    
    
13.     k = 0
    
14.     arr = Sheet1.Range("A1").CurrentRegion
    
15.     ReDim brr(1 To UBound(arr, 1), 1 To 3)
    
16.    
    
17.         For i = 2 To UBound(arr)
    
18.             s = arr(i, 2) & "/" & arr(i, 3)
    
19.             If s <> "" Then
    
20.             If d1.Exists(s) Then
    
21.                 brr(d1(s), 3) = brr(d1(s), 3) + 1
    
22.                 Else
    
23.                 k = k + 1: d1(s) = k
    
24.                 brr(k, 1) = arr(i, 2): brr(k, 2) = arr(i, 3): brr(k, 3) = 1
    
25.             End If
    
26.             End If
    
27. 
    
28.       Next
    
29.          
    
30.     j = Sheet1.[E65536].End(xlUp).Row
    
31. 
    
32.     If j > 2 Then
    
33.     Sheet1.Range(sheet1.Cells(2, 5),sheet1 .Cells(j, 7)).ClearContents  '清除原有内容
    
34.     End If
    
35. 
    
36.     sheet1.Range("E2").Resize(k, 3) = brr
    
37.    
    
38.     Set d1 = Nothing
    
39. Application.ScreenUpdating = True
    
40. Application.DisplayAlerts = True
    
41. End Sub

复制代码

king38425

melville 发表于 2019-6-13 16:35
代码如下

非常感谢，已满足要求

shi353

Sub tt2()
Dim A()
Set d = CreateObject("Scripting.Dictionary")
arr = Sheet1.[A1].CurrentRegion
For i = 2 To UBound(arr)
    d(arr(i, 2) & "|" & arr(i, 3)) = d(arr(i, 2) & "|" & arr(i, 3)) + 1
Next
'------------------------
S1 = d.keys
t1 = d.items
'------------------------
ReDim A(1 To 3, 1 To UBound(S1) + 1)
For i = 0 To UBound(S1)
    X = Split(S1(i), "|")
    A(1, i + 1) = X(0)
    A(2, i + 1) = X(1)
    A(3, i + 1) = d(S1(i))
Next
A = Application.Transpose(A)
Sheet1.[I2].Resize(UBound(A), UBound(A, 2)) = A
End Sub

king38425

shi353 发表于 2019-6-14 06:46
Sub tt2()
Dim A()
Set d = CreateObject("Scripting.Dictionary")

非常谢谢，比楼上朋友的要简单些，呵呵

king38425

shi353 发表于 2019-6-14 06:46
Sub tt2()
Dim A()
Set d = CreateObject("Scripting.Dictionary")

你好，请问VBA如何提取指定字符串后的内容呢？如图：

king38425

melville 发表于 2019-6-13 16:35
代码如下

你好，请问VBA如何提取指定字符串后的内容呢？如图：