Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

数据透视表40+个常用小技巧,让你一次学会!
查看: 252|回复: 3

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

[复制链接]
发表于 2022-11-27 09:59 | 显示全部楼层 |阅读模式
哪位大神帮忙下,用VBA取相同项目的最低值 取相同项目的最低值.zip (7.5 KB, 下载次数: 4)
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 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 | 显示全部楼层
  1. Sub 最小值()
  2.     Dim d, k As Integer, arr, str As String
  3.     Set d = CreateObject("scripting.dictionary")
  4.     arr = Range("a3").CurrentRegion
  5.     For k = 2 To UBound(arr)
  6.         str = arr(k, 3) & "" & arr(k, 4) & "" & arr(k, 5)
  7.         If Not d.exists(str) Then
  8.             d(str) = arr(k, 7)
  9.         Else
  10.             If arr(k, 7) < d(str) Then d(str) = arr(k, 7)
  11.         End If
  12.     Next k
  13.     For k = 2 To UBound(arr)
  14.         str = arr(k, 3) & "" & arr(k, 4) & "" & arr(k, 5)
  15.         arr(k, 7) = d(str)
  16.     Next k
  17.     Range("a3").Resize(UBound(arr), UBound(arr, 2)) = arr
  18. 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
GIF 2022-11-28 11-47-27.gif

取相同项目的最低值.rar

13.21 KB, 下载次数: 0

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

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

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表