## 用户名 Email 自动登录 找回密码 密码 注册
 搜索
 数据透视表40+个常用小技巧，让你一次学会！

# 如何用VBA取相同项目的最低值 发表于 2022-11-27 09:59 | 显示全部楼层 |阅读模式
 哪位大神帮忙下，用VBA取相同项目的最低值 取相同项目的最低值.zip (7.5 KB, 下载次数: 4) 2022-11-27 09:58 上传 点击文件名下载附件 ， 谢谢 发表于 2022-11-27 16:06 | 显示全部楼层 Sub 相同三项的最低单价() Dim arr Dim i As Integer Dim temp Dim str1 Dim str2 Dim dic As Object Set dic = CreateObject("scripting.dictionary") arr = Range("b1:h24") For i = 4 To UBound(arr)     temp = arr(i, 6)     For j = 4 To UBound(arr)     str1 = arr(i, 2) & "-" & arr(i, 3) & "-" & arr(i, 4)     str2 = arr(j, 2) & "-" & arr(j, 3) & "-" & arr(j, 4)         If str1 = str2 Then             imin = Application.WorksheetFunction.Min(temp, arr(j, 6))             temp = imin         End If     Next     dic(str1) = imin Next For i = 4 To UBound(arr)     str1 = arr(i, 2) & "-" & arr(i, 3) & "-" & arr(i, 4)     Cells(i, 10) = dic(str1) Next End Sub 发表于 2022-11-28 09:32 | 显示全部楼层
 Sub 最小值()     Dim d, k As Integer, arr, str As String     Set d = CreateObject("scripting.dictionary")     arr = Range("a3").CurrentRegion     For k = 2 To UBound(arr)         str = arr(k, 3) & "" & arr(k, 4) & "" & arr(k, 5)         If Not d.exists(str) Then             d(str) = arr(k, 7)         Else             If arr(k, 7) < d(str) Then d(str) = arr(k, 7)         End If     Next k     For k = 2 To UBound(arr)         str = arr(k, 3) & "" & arr(k, 4) & "" & arr(k, 5)         arr(k, 7) = d(str)     Next k     Range("a3").Resize(UBound(arr), UBound(arr, 2)) = arr End Sub 复制代码 发表于 2022-11-28 11:50 | 显示全部楼层
 Sub aaa()     Dim Cn As Object, StrSQL, Rs As Object, Arr As Variant, i%, j%     Set Cn = CreateObject("ADODB.Connection")     Set Rs = CreateObject("ADODB.recordset")     Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName     StrSQL = "Select 材料或设备名称,规格、型号,单位,min(单价) as 单价 From [Sheet1\$A3:H] Group by 材料或设备名称,规格、型号,单位"     Rs.Open StrSQL, Cn, 1, 3     Arr = Rs.getrows     For i = 0 To UBound(Arr, 2)         For j = 4 To Range("A" & Rows.Count).End(xlUp).Row             If Cells(j, "C") & Cells(j, "D") & Cells(j, "E") = Arr(0, i) & Arr(1, i) & Arr(2, i) Then Cells(j, "G") = Arr(3, i)         Next j     Next i End Sub  13.21 KB, 下载次数: 0

 本版积分规则 回帖后跳转到最后一页

GMT+8, 2023-2-5 19:52 , Processed in 0.535344 second(s), 9 queries , Gzip On, Yac On.