你如何在阵列中找到一个范围?注意:范围内的值必须列出所有可能的排列

问题描述 投票:0回答:2

我正在研究将返回概率测量的统计代码/函数。检查范围是否在数组内时,问题在于。然而,该范围也可以根据设定的标准改变。

假设你有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 example

我可以在数组中找到值{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矩阵/数组,这必须与我的初始问题> <

arrays vba comparison
2个回答
0
投票
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

0
投票
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
© www.soinside.com 2019 - 2024. All rights reserved.