Как найти макс.абсолютная последовательная разница двух значений в заданном диапазоне в VBA - PullRequest
0 голосов
/ 12 мая 2019

У меня есть определенный диапазон, например, B2-I2 (который может варьироваться), который содержит значения, например, 1,2,4,5,34,4,23,12.Цель состоит в том, чтобы иметь макрос, который находит наибольшую абсолютную разницу в данном диапазоне при выполнении функции.В приведенном выше примере самый большой абс.разница будет 30 (как 34-4).

Ответы [ 2 ]

2 голосов
/ 13 мая 2019

Похоже, вы хотите найти наибольшее последовательное различие, если так, попробуйте это ...

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))

enter image description here

enter image description here

1 голос
/ 13 мая 2019

попробуй:

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
...