Question

我有一个电子组件列表，它们的名称位于 A列，其值在 B列。

我想搜索每个组件（每一行）与所有其他行的最佳匹配（我不想使用2 For循环）。我也需要它在VBA中，因为我有其他功能在VBA中处理。

解释：最佳匹配将是行，其中组件值与搜索到的组件行一起最接近36。

示例（参见下表中的一部分），第2行，电容1，其值为17.97822949，我想找到最佳行，与该电容一起，它们的总值为36（其中意味着，它的值最接近18.02177051的电容器。

挑战/问题：找到Match，Min和Abs的组合，它们将返回行号和电容值（C列和D列）。

我目前的代码：

Option Explicit

Sub Match_Min_Abs()

Dim C_Sht                               As Worksheet
Dim C_Col                               As Integer
Dim C_Row                               As Long
Dim Last_Row                            As Long
Dim Capacitor_Val                       As Double
Dim Current_Rng                         As Range
Dim Row_Found                           As Long
Dim Minimum_Gap                         As Double


Set C_Sht = ThisWorkbook.Worksheets("C_Data")

' find last row in sheet
Last_Row = Cells(Rows.Count, "B").End(xlUp).row

' Capacitors column B
C_Col = 2

For C_Row = 2 To Last_Row - 1

     ' set current search range (from next row till last row)
    Set Current_Rng = C_Sht.Range(Cells(C_Row + 1, C_Col), Cells(Last_Row, C_Col))


    ' ****** this is the part I can't get the right set of functions to work *****
    Row_Found = Application.Match(WorksheetFunction.min(Abs(36 - (Current_Rng + Cells(C_Row, C_Col)))))

   ' Capacitor_Val = Application.Index(Current_Rng, Application.Match(WorksheetFunction.min(Abs(Current_Rng - 36)), Abs(Current_Rng - 36), 0))

    C_Sht.Cells(C_Row, C_Col + 1).Value = Row_Found
    C_Sht.Cells(C_Row, C_Col + 2).Value = Capacitor_Val

Next C_Row

End Sub

Answer 1

感谢 @Scott Craner 的帮助，稍加修改（需要添加Current_Rng.Address，并删除一些额外的spaces），我就可以使用它。这很重要，因为使用2个For循环来覆盖包含超过5000个组件的Excel工作表，有时需要超过2分钟才能运行。

Option Explicit

Sub Match_Min_ABS()

Dim C_Sht                               As Worksheet
Dim C_Col                               As Integer
Dim C_Row                               As Long
Dim Last_Row                            As Long
Dim Capacitor_Val                       As Double
Dim Current_Rng                         As Range
Dim Row_Found                           As Long
Dim Minimum_Gap                         As Double
Dim Function_Str                        As String


Set C_Sht = ThisWorkbook.Worksheets("C_Data")

' find last row in sheet
Last_Row = Cells(Rows.Count, "B").End(xlUp).row

' Capacitors column B
C_Col = 2

For C_Row = 2 To Last_Row - 2

     ' set current search range (from next row till last row)
    Set Current_Rng = C_Sht.Range(Cells(C_Row + 1, C_Col), Cells(Last_Row, C_Col))

    ' use a string first (easier to debug later)  
    Function_Str = "MATCH(MIN(ABS(36-(" & Current_Rng.Address & "+" & C_Sht.Cells(C_Row, C_Col).Address & ")))," & _
            "ABS(36-(" & Current_Rng.Address & "+" & C_Sht.Cells(C_Row, C_Col).Address & ")),0)"                    
    Row_Found = C_Sht.Evaluate(Function_Str) + C_Row     

    Capacitor_Val = C_Sht.Cells(Row_Found, C_Col)
    C_Sht.Cells(C_Row, C_Col + 1).Value = Row_Found
    C_Sht.Cells(C_Row, C_Col + 2).Value = Capacitor_Val

Next C_Row

End Sub

综合使用功能匹配＆amp; Min＆amp;阿布斯

1 个答案: