Question

我在Excel中使用1066 x 592矩阵（比方说，M）。我想构建一个代码，将其适当地转换为592 x 592矩阵（比方说，A）。矩阵M是二进制矩阵（单元格值为0或1）。现在，假设对于M的R1，单元（R1，C1），（R1，C6），（R1，C400）和（R1，C550）为1s，其余为0s。然后，我想构建一个大小为4的数组（=行中的1个数），它存储值（1,6,400,550）=（在R1中包含1的列号）。然后，我想要一个变量只通过这4个值循环，这样，在矩阵A中，单元格（1,6），（1,400），（1,550），（6,400），（6,550），（400,550），（6），1），（400,1），（550,1），（400,6），（550,6），（550,400）=（所有可能的长度为2的排列）将1加到它们先前的值（最初为0）。

我从总结所有行开始，因此每行的总和显示在列号中。该行的594。然后，

Sub ConnMat()

Dim i As Integer
Dim j As Integer
Dim r As Integer

For i = 2 To 1067

If Worksheets("Sheet3").Cells(i, 594).Value > 1 Then
Dim k As Integer
Dim k() as Integer
k = Cells(i, 594).Value    #no.of 1s in row i = length of array
For r = 1 To k
For j = 2 To 593
If Worksheets("Sheet3").Cells(i, j).Value = 1 Then
k(r) = j   #recording the column no containing 1 (=j) as the rth value of the array 
Next r
Next j




Worksheets("Sheet2").Cells(i, i).Value = Cells(i, j).Value + 1
End If
End If
Next i

我是新手，但我还没有完成代码（因为没有创建数组而无法继续）。另外，我查看了其他一些帖子，例如Assigning an array value to a variable inside a for loop in vba ......但无法从他们那里获得价值。请帮助。

Answer 1

使用小型数据集进行测试 - 似乎工作正常：

Sub Tester()

    Const INPUT_ROWS As Long = 1066
    Const INPUT_COLS As Long = 592

    Dim r As Long, c As Long, c2 As Long, arr, sht As Worksheet
    Dim A(1 To INPUT_COLS, 1 To INPUT_COLS) As Long 'output array

    Set sht = Worksheets("Sheet1")

    'get the input values into a 2-D array
    arr = sht.Range("A1").Resize(INPUT_ROWS, INPUT_COLS).Value

    For r = 1 To INPUT_ROWS
        For c = 1 To INPUT_COLS
            If arr(r, c) = 1 Then
                'got a "1" - find others and combine pairs
                For c2 = (c + 1) To INPUT_COLS
                    If arr(r, c2) = 1 Then
                        'add pair to output array
                        A(c, c2) = A(c, c2) + 1
                        A(c2, c) = A(c2, c) + 1
                    End If
                Next c2
            End If
        Next c
    Next r

    'drop output array to worksheet
    sht.Range("A1").Offset(0, INPUT_COLS + 5).Resize( _
                       INPUT_COLS, INPUT_COLS).Value = A

End Sub

Answer 2

SELECT r1.ColegeName, r1.Subject, r1.Position r2.WorkLoad, r2.Posts FROM r1 LEFT JOIN r2 ON r1.CollegeName = r2.CollegeName AND r1.Subject = r2.Subject是输入（矩阵M）表，Sheet3是输出（结束矩阵M）表。

Sheet2

第一个代码首先将所有Matrix A的值相加然后将它们添加到Matrix M.但是如果你想逐行执行此操作，我的意思是，如果它将在前一个Matrix A之后计算下一个Matrix A已经应用，这是代码：

Private Sub ReMatrixM()
    Dim arrInput() As Variant
    Dim arrSumOfMatrixAs(592, 592) As Long

    Dim Ones() As Integer 'An array keeping indexes of columns which iclude 1.
    Dim iOnes As Integer
    Dim RowM As Integer, ColM As Integer, iRowA As Integer, iColA As Integer

    Dim shtM As Worksheet, shtM2 As Worksheet, cell As Variant

    '1. Take the values included in the sheet in an array
    Set shtM = Worksheets("Sheet3")
    arrInput = shtM.Range("B2").Resize(1066, 592)

    '2. We find columns which includes 1s
    '3. We will use this column indexes by binary combinations to fint the coordinates where 1s are to be added.

    'Now we cycle all rows of array
    For RowM = 1 To 1066 'Rows

        ReDim Ones(0)
        iOnes = 0

        'Now we cycle all colums for each row of array
        For ColM = 1 To 592 'Columns

            If arrInput(RowM, ColM) = 1 Then
                iOnes = iOnes + 1
                ReDim Preserve Ones(iOnes)
                Ones(iOnes) = ColM 'We are taking indexes of columns which includes one.
            Else
               arrInput(RowM, ColM) = 0
            End If

        Next

        If UBound(Ones) > 0 Then

            'For every row of arrInput add the values say cells of Matrix A (arrSumOfMatrixAs).
            For iRowA = 1 To UBound(Ones)
                For iColA = 1 To UBound(Ones)
                    arrSumOfMatrixAs(Ones(iRowA), Ones(iColA)) = arrSumOfMatrixAs(Ones(iRowA), Ones(iColA)) + 1
                Next
            Next

        End If

    Next

    'Than we add the sum of "matrix A"s to arrInput
    For RowM = 1 To 592
        For ColM = 1 To 592
            arrInput(RowM, ColM) = arrInput(RowM, ColM) + arrSumOfMatrixAs(RowM, ColM)
        Next
    Next

    Set shtM2 = Worksheets("Sheet2")
    'We reflect the arrInput to the sheet (Matrix M) at the end.
    shtM2.Range("B2").Resize(1066, 592) = arrInput

End Sub

如何在vba中的变量数组上运行for循环？

2 个答案: