Question

在我的代码的一部分中，我读了一个矩阵

Dim matr As Variant, mat As Variant, vec As Variant
matr = Worksheets("portfolio").Range("A2:K163")

现在在两个if-loops之后我想将整行复制到一个新矩阵

For i = 1 To lngRow
    For j = 2 To ingRow
        If matr(i, 11) = matr(j, 11) Then
            If matr(i, 4) = matr(j, 4) Then
                matr(j,...)=mat(j,...)
            End If
        End If
    Next j
Next i

如何将整行从现有矩阵复制到另一个矩阵？

Answer 1

如果我理解您的请求，这里有一些代码可以帮助您。我已经对它进行了评论以供解释。

主要要点是：mat动态增长，以便它可以包含来自matr的新行数据。然后复制该行。

当然，如果您允许将mat初始化为与matr相同的大小并且有许多空行，则可以忽略ReDim和使用的所有工作底部的循环复制行。

编辑：我已对此进行了编辑，以便注意Preserve。从文档中，Preserve只能用于更改最后一个维度。因为这不是这种情况，所以在添加新行之前将数据复制到临时数组。

    Option Base 1

Sub rr()

    ' Initialise 2D array to a range
    Dim matr As Variant
    Dim rng As Range

    Set rng = ActiveSheet.Range("A1:D7")
    matr = rng

    ' Range used so column count can be fetched easily
    Dim colCount As Long
    colCount = rng.Columns.Count

    ' Initialise empty 2D array for populating with given rows from matr
    Dim mat() As Variant
    Dim matTemp() As Variant

    ' Test conditions simplified for demo
    Dim someCondition As Boolean
    someCondition = True

    ' upper bound of mat, for testing if it is dimensioned
    Dim ub As Long
    Dim m As Long, n As Long
    Dim rowToCopy As Long

    For rowToCopy = 1 To 2

        If someCondition = True Then

            ' test if dimensioned already
            ub = 0
            On Error Resume Next
            ub = UBound(mat)
            On Error GoTo 0

            If ub = 0 Then
            ' if no, dimension it to 1 row
                ReDim mat(1, colCount)
            Else
            ' if yes, dimension it to 1 extra row
                ReDim matTemp(ub + 1, colCount)
                For m = 1 To ub
                    For n = 1 To colCount
                        matTemp(m, n) = mat(m, n)
                    Next n
                Next m
                ReDim mat(ub + 1, colCount)
                mat = matTemp
            End If

            ' Assign 'columns' of 2D array matr to new array mat
            For m = 1 To colCount
                mat(ub + 1, m) = matr(rowToCopy, m)
            Next m

        End If

    Next rowToCopy

End Sub

使用vba将整行从一个矩阵复制到另一个矩阵

1 个答案: