如何找到最大VBA中给定范围内两个值的绝对顺序差

Question

我有一个特定的范围，例如B2-I2（可以变化），它包含例如1,2,4,5,34,4,23,12的值。目的是要有一个宏，当执行该函数时，该宏在给定范围内找到最大的绝对差。在上面的示例中，最大吸收值。差异为30（如34-4）。

Answer 1

您似乎想找到最大的顺序差异，如果可以，请尝试...

Public Function GetLargestDifference(ByVal objCells As Range) As Double
    Dim objCell As Range, i As Long, dblThisDiff As Double, arrValues()

    ' Put the (potentially) non sequential set of cells into a one dimensional array.
    For Each objCell In objCells
        ReDim Preserve arrValues(i)
        arrValues(i) = objCell.Value
        i = i + 1
    Next

    ' Now process that array and check for the max difference.
    For i = 0 To UBound(arrValues) - 1
        dblThisDiff = arrValues(i) - arrValues(i + 1)
        If dblThisDiff > GetLargestDifference Then GetLargestDifference = dblThisDiff
    Next
End Function

...没有错误检查非数字值，但您可以根据需要添加它。

如果需要进行绝对检查，则替换此行...

dblThisDiff = arrValues(i) - arrValues(i + 1)

...与此...

dblThisDiff = Abs(arrValues(i) - arrValues(i + 1))

Answer 2

尝试：

Option Explicit

Sub test()

    Dim i As Long, y As Long, ValueArr As Long, ValueY As Long, MaxDiff As Long
    Dim arr As Variant

    With ThisWorkbook.Worksheets("Sheet1")

        arr = Application.Transpose(.Range("B2:I2").Value)

        For i = LBound(arr) To UBound(arr)

            ValueArr = Abs(arr(i, 1))

            For y = 2 To 9

                ValueY = Abs(.Cells(2, y).Value)

                If ValueArr - ValueY > MaxDiff Then
                    MaxDiff = ValueArr - ValueY
                End If

            Next y

        Next i

        MsgBox MaxDiff

    End With

End Sub