关键字有多个不同项，怎么同时写入字典

chxw68

详见附件。

bosao

chxw68 发表于 2017-3-6 16:31
详见附件。

谢谢帮助，这个代码实现了所有不同类别（条件列不同的算作不同类别）各自最大量所在行数据的汇总效果，收藏备用。

sxl820

刚开始学习VBA，一头乱麻

jiangxiaoyun

1. Sub vv()
   
2.     Dim arr, brr
   
3.     arr = Sheet1.[a1].CurrentRegion
   
4.     ReDim brr(1 To UBound(arr), 1 To 6)
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     For i = 2 To UBound(arr)
   
7.         s = arr(i, 1) & arr(i, 2) & arr(i, 3) & arr(i, 4)
   
8.         If Not d.exists(s) Then
   
9.             k = k + 1
   
10.             d(s) = k
    
11.             For j = 1 To 5
    
12.                 brr(k, j) = arr(i, j)
    
13.             Next
    
14.             brr(k, 6) = i
    
15.         Else
    
16.             If arr(i, 5) > brr(d(s), 5) Then
    
17.                 brr(d(s), 5) = arr(i, 5)
    
18.                 brr(d(s), 6) = i
    
19.             End If
    
20.         End If
    
21.     Next
    
22.     Sheet2.[a2:f55555] = ""
    
23.     Sheet2.[a2].Resize(k, 6) = brr
    
24. End Sub
    

复制代码

jiangxiaoyun

VBA多条件查询0717 - 副本.rar (16.22 KB, 下载次数: 16)

2018-3-14 10:10 上传

点击文件名下载附件

sdg1345

Sub 宏1()
Dim dic As Object
Dim arr(1 To 100, 1 To 10)

Set dic = CreateObject("scripting.dictionary")

With Sheet1
    ar = .Range("a1").CurrentRegion
    For i = 2 To UBound(ar)
        s = ar(i, 1) & "▲" & ar(i, 2) & "▲" & ar(i, 3)
        If Not dic.exists(s) Then
            dic(s) = i
        Else
            k = dic(s)
            If ar(i, 5) > ar(k, 5) Then
                dic(s) = i
            End If
        End If
    Next i
End With

With Sheet2
    ar = .Range("a1").CurrentRegion
    For i = 2 To UBound(ar)
        s = ar(i, 1) & "▲" & ar(i, 2) & "▲" & ar(i, 3)
        Cells(i, 6) = dic(s)
    Next i
End With

Set dic = Nothing

End Sub