在VBA中，数组元素的返回索引在容错范围内

有没有一种简单的方法，不是在数组中循环，而是使用VBA中的函数，比如Application.Match（val、arr、False | true），在一定的公差范围内，找到浮点数数组中元素的索引？在公差范围内，我的意思是如果元素在目标值加上和减去公差的范围内，即小正数

---

Trimax评论说，这是的副本。事实并非如此，这个问题的答案当然不能回答我的问题，即使这两个问题是相关的。这个问题要求一个整数的索引可以精确匹配，而我的问题要求一个数字的索引在目标的非零公差范围内，而不是完全相等。所以这个答案不适用。

作为练习，我选择了一组随机浮点数：

3.5,3.1,3.3,3.9,3.2,3.1,3.7,3.5,3.7

以及任意最小值（

3.3

）和最大值（

3.7

）限制

为了得到相同的结果，我还将条件格式替换为自动筛选

代码将创建一个新的工作表

• 将数组值放在第1列中
• 使用索引（行号）创建新列
• 应用自动筛选仅显示最小值和最大值之间的浮点数
• 从第2列捕获所有可见索引
• 删除临时工作表并显示消息

---

---

结果:

如果您使用的是大型阵列，则可以针对性能对算法进行优化

---

如果您需要更多详细信息，请告诉我

如果您在一列中有这些详细信息，您可以尝试在+=3.597+=3.599之间使用条件格式设置

单元格值+，将它们涂成红色，然后在红色上应用自动筛选，并使用
变量=.Columns（5）.特殊单元格（xlCellTypeVisible）
获取数组循环有什么问题？应该足够简单，可以将逻辑抽象为函数。@Trimax:不，不是。请仔细阅读这个问题。这个问题要求整数的索引可以精确匹配。我要的是一个数字的索引，该数字在目标的非零公差范围内，而不是完全相等。@paulbica:聪明的解决方案。@Hans你说得对，对不起。我已经删除了注释。所有操作都应该在VBA中完成，而不是使用GUI。我想您可以用VBA行替换GUI调用过程。希望它不会太麻烦。我使用GUI只是为了说明，但是有一些特定的VBA元素需要使用，比如
Range.FormatConditions（formatConditionId）
。如果你能提供更多关于你的特殊任务的细节，我可以做一些例子。没有比下面更多的细节了。这里有一个浮点数数组，我想找到数组元素的索引，该索引与给定的数字之间的距离在预先指定的范围内（误差容限）。该距离小于数组中任何相邻数字之间差值的最小值。
Option Explicit

'Place the code in a new module (from the menu: Insert -> Module)

Public Sub getIndexes()

    Const MIN       As String = "3.3"
    Const MAX       As String = "3.7"
    Const FLOATS    As String = "3.5, 3.1, 3.3, 3.9, 3.2, 3.1, 3.7, 3.5, 3.7"

    Dim ws As Worksheet, arr As Variant, arrMax As Long
    Dim indx As Variant, c1 As Range, c2 As Range

    Application.ScreenUpdating = False
    Set ws = getNewWorkSheet("TestIndexes")
    arr = Split(FLOATS, ", ")
    arrMax = UBound(arr) + 1
    With ws
        Set c1 = .Range(.Cells(1, 1), .Cells(arrMax, 1))
        Set c2 = .Range(.Cells(1, 2), .Cells(arrMax, 2))
        c1 = Application.Transpose(arr)
        c2.Formula = "=ROW()"
        c1.AutoFilter Field:=1, _
                      Criteria1:=">=" & MIN, _
                      Operator:=xlAnd, _
                      Criteria2:="<=" & MAX
        c2.SpecialCells(xlCellTypeVisible).Copy .Cells(arrMax + 2, 1)
        indx = .Range(.Cells(arrMax + 2, 1), .Cells(.UsedRange.Rows.Count, 1)).Value2
    End With
    removeWorkSheet ws.Name
    Application.ScreenUpdating = True

    arr = Join(Application.Transpose(indx), ",   ")
    MsgBox "Indexes of values between  " & MIN & "  and  " & MAX & ":   " & arr
End Sub

Public Function getNewWorkSheet(ByVal wsName As String) As Worksheet
    Dim thisWS As Worksheet, activeWS As String
    activeWS = ActiveSheet.Name
    removeWorkSheet wsName
    Set thisWS = Worksheets.Add(Sheets(1))
    thisWS.Name = wsName
    Worksheets(activeWS).Activate
    Set getNewWorkSheet = thisWS
End Function

Public Sub removeWorkSheet(ByVal wsName As String)
    Dim thisWS As Worksheet
    For Each thisWS In ActiveWorkbook.Worksheets
        If thisWS.Name = wsName Then
            Application.DisplayAlerts = False
            thisWS.Delete
            Application.DisplayAlerts = True
            Exit For
        End If
    Next
End Sub