如何用VBA取相同项目的最低值

fggf

如何用VBA取相同项目的最低值 取相同项目的最低值.zip (7.5 KB, 下载次数: 16)

2022-11-27 09:52 上传

点击文件名下载附件

，求帮忙，谢谢！

清梦扰

供参考……

fzxba

1. Sub test1()
   
2.   Dim vData, Dict As Object
   
3.   Dim i As Long, strKey As String
   
4.   Set Dict = CreateObject("Scripting.Dictionary")
   
5.   vData = Range("A3").CurrentRegion
   
6.   For i = 2 To UBound(vData)
   
7.     strKey = vData(i, 3) & "|" & vData(i, 4) & "|" & vData(i, 5)
   
8.     If Dict.Exists(strKey) Then
   
9.       If vData(i, 7) < Dict(strKey) Then Dict(strKey) = vData(i, 7)
   
10.     Else
    
11.       Dict.Add strKey, vData(i, 7)
    
12.     End If
    
13.   Next
    
14.   For i = 2 To UBound(vData)
    
15.     strKey = vData(i, 3) & "|" & vData(i, 4) & "|" & vData(i, 5)
    
16.     vData(i, 1) = Dict(strKey)
    
17.   Next
    
18.   Range("G3").Resize(UBound(vData), 1) = vData
    
19.   Set Dict = Nothing
    
20.   Beep
    
21. End Sub

复制代码

清风竹-

请看附件。

3190496160

清风竹- 发表于 2022-11-27 10:42
请看附件。

老兄的这句代码，深受启发啊，之前一直卡在这儿了，
If b(i, 2) < d.Item(ss) Then d(ss) = b(i, 2)

准提部林

Sub TEST_A1()
Dim Arr, xD, T$, i&, V
Set xD = CreateObject("scripting.dictionary")
Arr = Range([h1], [a65536].End(3))
For i = 4 To UBound(Arr)
    T = Arr(i, 3) & Arr(i, 4) & Arr(i, 5):  Arr(i, 4) = T
    If xD(T) = "" Or Arr(i, 7) < xD(T) Then xD(T) = Arr(i, 7)
Next i
For i = 4 To UBound(Arr)
    Arr(i - 3, 1) = Arr(i, 6)
    Arr(i - 3, 2) = xD(Arr(i, 4))
    Arr(i - 3, 3) = Arr(i, 6) * xD(Arr(i, 4))
Next i
[f4].Resize(UBound(Arr) - 3, 3) = Arr
End Sub