Как вы находите диапазон в массиве? Примечание: значения в диапазоне должны перечислять все возможные перестановки

Question

Я работаю над статистическим кодом / функцией, которая будет возвращать меру вероятности.проблема заключается в проверке, находится ли диапазон в массиве или нет.Однако этот диапазон также может изменяться в соответствии с установленными критериями.

Допустим, у вас есть массив с 25 строками и 2 столбцами.в этом случае A1: B25 первым диапазоном, который вы хотите проверить в этом массиве, является A1: B1 в массиве A1: B25.

с некоторыми включенными критериями, значения этого диапазона могут изменяться.если массив в двух столбцах равен

9   4
4   8
8   1
1   2
2   4

, а диапазон, который вы хотите проверить, равен

9   4

, а критерии - 1 (+ -1), что означает, что мы хотим найтиэтот диапазон между -1 и 1 в массиве.таким образом, первая проверка состоит в том, чтобы увидеть, существует ли {9, 4}, то есть, поскольку там присутствуют две ступени, возвращается 1 найденный, но {9,5} {10,5} {10,4} {9,3} {8,4} {8,5} {10,3} {8,3}, не существует в массиве и ничего не возвращает.поэтому найдено только 1 значение.

Извинения, если я не объясняю это должным образом.надеюсь, поможет изображение ниже.щелкните это: Пример Excel

Я могу найти значения {8, 3} {9, 4} {10, 5} в массиве, следовательно, с этими критериями, {-1,-1} {0, 0} {1, 1} в массиве (два столбца), но не {-1, 0} {0, -1} {1, -1} {-1, 1} {-1, -1}.

Что подводит меня к моей проблеме.

приведенный ниже код находит каждый диапазон в массиве.но только сколько раз он видит себя в массиве.поэтому нет перестановок в пределах допуска + -r

Sub get_matches()
'note this isnt dynamic and only works for columns of 2
Dim arr() As Variant, trr As Variant
Dim i As Long, j As Long, m As Double
Dim ans As Double, r As Double

ans = 0
m = 2
arr = Range("A2:B26").value

For k = 2 To 26
trr = Range("A" & k & ":B" & k).value
For i = 1 To UBound(arr, 1)  ' Iterate through the rows of the array
For j = 1 To UBound(arr, m)  'iterate through the columns of the array
If arr(i, j) = trr(1, j) Then
j = j + 1
If j <= m Then
If arr(i, j) = trr(1, j) Then
ans = ans + 1
Else
ans = ans
End If
End If
End If
Next
Next
Range("N" & k).value = ans
ans = 0
Next k

Отметим, что исходный массив, который у меня есть, является динамическим.поэтому размер диапазона может изменяться, а размер массива также может меняться в зависимости от критериев.границы для массива (от 1 до rowcount, от 1 до columncount) от диапазона (i, 1 до columncount), если вы понимаете, что я имею в виду.поэтому размер может измениться.

, например:

Function ChangeMatrixTwo(ByRef inputCol As Range, NumCols As Long) As 
Variant

'recreate the range of your data into the different vector sizes.
'the vector size m and m+1 
'by resizing the range into the vector wanted with values following after 
each other
'to better explain, should you have a series 123456, for vector 2, it will 
return {1,2} {2,3} {3,4} {4,5} {5,6}

Dim NewMatrix() As Variant
Dim i, j, k, n As Long
Dim rowsize As Long

n = inputCol.Count
rowsize = n - NumCols + 1

ReDim NewMatrix(1 To rowsize, 1 To NumCols)
k = 1
For i = 1 To rowsize
For j = 1 To NumCols
NewMatrix(i, j) = inputCol(k, 1)
k = k + 1
Next j
k = k - NumCols + 1
Next i
ChangeMatrixTwo = NewMatrix
End Function

, изменив номер столбца, я могу сгенерировать матрицу / массив m и m + 1, и это я должен объединить с моей первоначальной проблемой><</p>

Answer 1

Function ApCounter(BigArray As Range, CompareArr As Variant, Crit As Integer)
'function to count a range within the array that is within a certain bounds
'the array is BigArray and the range we finding is the CompareArr, the bounds we call Crit

Dim i, j, rowSize, colSize As Long
Dim ans As Double
Dim r As Integer
Dim counter As Double

counter = 0
ans = 0
rowSize = BigArray.Rows.Count
colSize = BigArray.Columns.Count

For i = 1 To rowSize  ' Iterate through the rows of the array
    For j = 1 To colSize 'iterate through the columns of the array
        For r = -Crit To Crit 'iterate alternate values
            Do While BigArray(i, j) = CompareArr(1, j) + r
                counter = counter + 1
                r = r + 1
            Loop
            If counter = colSize Then
                ans = ans + 1
            Exit For
            Else
                ans = ans
            End If
        Next
    Next
    counter = 0
Next
 ApCounter = ans

End Function

Answer 2

How do you find a range in an array?
I find it very difficult.
Needed to do major surgery on this.  
>finds each permutation within the tolerance of +-rTolerance
>dynamic and works for any columns
>Missing is any correction for Negative values in PermutedARow
>Missing is ChangeMatrixTwo

Option Explicit

Sub doit()
    ' example of your calling syntax

     get_matches   ' pass no args, use default values

    ' or pass any args using colon&equals :=   and separate args with commas
    get_matches argResultColumn:="C"

End Sub


Sub get_matches(Optional argSheet As String = "Sheet1", Optional argRange As String = "A2:B26", _
     Optional argTolerance As String = "1", Optional argResultColumn As String = "N")

    ' note: the code below finds each permutation within the tolerance of +-rTolerance
    ' note: this is dynamic and works for any columns

    Sheets(argSheet).Select


    Dim Arr() As Variant, AmaxRows As Long, AmaxCols As Long, ARow As Long, ACol As Long
    Arr = Range(argRange).Value
    ' e.g. base is cell(2,"A"), aka "A2",  and numRows is 25, and numCols is 2
    AmaxRows = UBound(Arr, 1) - LBound(Arr, 1) + 1
    AmaxCols = UBound(Arr, 2) - LBound(Arr, 2) + 1
    'MsgBox ("r=" & AmaxRows & " C=" & AmaxCols & "  L1=" & LBound(Arr, 1) & " U1=" & UBound(Arr, 1) & "  L2=" & LBound(Arr, 2) & " U2=" & UBound(Arr, 2))

    ' create array of Tolerances -- e.g. tol=2 has array of  -2, -1, 0, 1, 2
    Dim rTolerance As Long, rNdx As Long, rTolMax As Long, rTolRange() As Variant, rx As Long
    rTolerance = argTolerance      ' could be = 0, 1, 2, 3, 4, ...
    rTolMax = ((rTolerance + rTolerance) + 1)
    ReDim rTolRange(0 To rTolMax - 1) As Variant
    rx = -1 * rTolerance
    For rNdx = LBound(rTolRange, 1) To UBound(rTolRange, 1)
        rTolRange(rNdx) = rx
        rx = rx + 1
    Next rNdx

    ' create Permutations array, and have subprogram compute the items
    Dim Permutations() As Variant
    ReDim Permutations(0 To (rTolMax ^ AmaxCols) - 1, 0 To AmaxCols - 1) As Variant
    Call ComputePermutations(rTolMax, rTolRange, Permutations)


    ' BIG LOOP--step down the Array rows
    For ARow = 1 To AmaxRows ' 2 To 26

        ' clone Permutations into PermutedARow, and add in  Arr(ARow) across each item
        Dim PermutedARow() As Variant
        PermutedARow = Permutations
        For rNdx = 0 To UBound(PermutedARow, 1)
            For ACol = 0 To UBound(PermutedARow, 2)
                PermutedARow(rNdx, ACol) = PermutedARow(rNdx, ACol) + Arr(ARow, ACol + 1)
            Next ACol
        Next rNdx

'====>>> This does not handle NEGATIVE value(s) in an Item in PermutedARow
'====>>> Unique ABSOLUTE valued items should be allowed
'====>>> (non-unique ones stay negative so we don't double count)
'====>>> can only be done after entire PermutedARow is made.


        ' now restart at the top of the Array and look/count each matching PermutedARow-s to each Arr row
        Dim iRow As Long, jCol As Long
        Dim ans As Long
        ans = 0

        ' for each row in the array
        For iRow = 1 To AmaxRows              ' Iterate through the rows of the Array

            ' match to each set of adjusted columns
            For rNdx = 0 To UBound(PermutedARow, 1)

                ' assume EQ
                Dim compared As String
                compared = "EQ"

                ' compare its columns to adjusted columns
                For ACol = 0 To UBound(PermutedARow, 2)          ' iterate through the columns of the Array

                    If PermutedARow(rNdx, ACol) <> Arr(iRow, ACol + 1) Then
                        compared = "NE"
                        Exit For
                    End If

                Next ACol

                If compared = "EQ" Then
                    ans = ans + 1
                End If

            Next rNdx

        Next iRow
        Range(argResultColumn & ARow + 1).Value = ans

    Next ARow
End Sub


Sub ComputePermutations(rTolMax As Long, rTolRange() As Variant, Permutations() As Variant)
    ' 2 cols, rTol=1 ==> 0-8, 0-1
    ' 3 cols, rTol=1 ==> 0-26, 0-1
    ' 3 cols, rTol=2 ==> 0-26, 0-2

    Dim whichTolItem As Long, colOfTolItem As Long
    Dim Dividend As Long, Divisor As Long, Quotient As Long, Remainder As Long

    For whichTolItem = 0 To UBound(Permutations, 1)

        Dividend = whichTolItem

        For colOfTolItem = 0 To UBound(Permutations, 2) - 1 'maxCol - 1
            Divisor = rTolMax ^ (UBound(Permutations, 2) - colOfTolItem)
            Quotient = Dividend \ Divisor  ' integer division
            Permutations(whichTolItem, colOfTolItem) = rTolRange(Quotient)
        Next colOfTolItem

        Remainder = Dividend Mod Divisor
        Permutations(whichTolItem, colOfTolItem) = rTolRange(Remainder)


'        ' un-comment this to show the various Permutations
'        Dim prt As String
'        prt = ""
'        Debug.Print " "
'        For colOfTolItem = 0 To UBound(Permutations, 2)
'            prt = prt & " , " & Permutations(whichTolItem, colOfTolItem)
'        Next colOfTolItem
'        Debug.Print whichTolItem, prt

    Next whichTolItem

End Sub