在运行时获取数据

Question

我必须将表格行捕获到二维数组中。我使用以下代码

代码：

Sub multiarr()

    Dim str As String      'String Which i am looking for
    Dim result() As String 'Stores Splitted Substring
    Dim r As Integer       ' Row Counter of 2d array
    Dim c As Integer       ' Column Counter of 2d Array
    Dim valarr() As String ' Initial Declaration of Array

    'Row and Column Initialization
    r = 0
    c = 0

    'Calculate Last Row and Last Column of Sheet
    mylr = Cells(Rows.Count, 1).End(xlUp).Row
    lcol = Cells(1, Columns.Count).End(xlToLeft).Column

    'Initialize the Array according to Sheet Dimentions
    ReDim valarr(mylr - 2, lcol - 1) 'Declare Array to be of size of Sheet

    str = "M1" ' -> This i am interested in.Only these records will be populated

    For y = 0 To UBound(valarr) 'iterate through rows of array
        For x = 2 To mylr           'iterate through rows of sheet
            result = Split(Cells(x, 1), "@") ' Split the Record
            If result(0) = str Then     'Check for the Condition
                'Array Filling Logic
                For c = 1 To lcol
                    ' C-1 because column index starts from 0
                    valarr(y, c - 1) = Cells(x, c)
                Next c
            End If
        Next x
    Next y

End Sub

但是这段代码填写错误。有什么问题？

请参阅工作表的示例图片

提前致谢

Answer 1

这个答案只解决了将范围变为二维数组的问题，而不是处理元素。

此代码是一种非常有效的方法：

Sub multiarr()
    Dim str As String 'String Which i am looking for
    Dim result() As String 'Stores Splitted Substring
    Dim r As Integer ' Row Counter of 2d array
    Dim c As Integer ' Column Counter of 2d Array
    Dim valarr()

    valarr = Range("A1").CurrentRegion
    MsgBox LBound(valarr, 1) & "-" & UBound(valarr, 1) & vbCrLf & LBound(valarr, 2) & "-" & UBound(valarr, 2)
End Sub

如果您无法根据需要调整方法，请忽略此答案。

Answer 2

使用自动过滤器（请参阅代码中的注释）：

Sub multiarr()

    Dim rng As Range, rngData As Range, rngFilter As Range

    '// Full range
    Set rng = Range("A1").CurrentRegion
    '// Range without a header
    With rng
        Set rngData = .Offset(1).Resize(.Rows.Count - 1)
    End With
    rng.AutoFilter Field:=1, Criteria1:="M1*"
    '// Error handling in case if no rows will be filtered
    On Error Resume Next
    Set rngFilter = rngData.SpecialCells(xlCellTypeVisible)
    If Err = 0 Then
        '// Do something with your range.
        '// Do not forget to use Areas,
        '// since rngFilter can be non-contiguous:
        '// Dim cell As Range, rngRow As Range, rngArea As Range
        '// For Each rngArea in rngFilter.Areas
        '//     For Each cell in rngArea
        '//     'Or For Each rngRow in rngArea.Rows
        '//         // Do something...
        '//     Next
        '// Next
    End If
    On Error GoTo 0

End Sub

Answer 3

请看下面的内容，希望有所帮助

Sub multiarr()

    Dim str As String      'String Which i am looking for
    Dim result() As String 'Stores Splitted Substring
    Dim r As Integer       ' Row Counter of 2d array
    Dim c As Integer       ' Column Counter of 2d Array
    Dim valarr() As String ' Initial Declaration of Array
    Dim mylr As Long, lcol As Long  'lastrow / lastcol

    'I recommend declaring the workbook/worksheet and declaring the ranges accordingly
    'Without doing so, any range refence bellow is explicit to the ActiveSheet

    Dim arrValues As Variant
    Dim cnt As Long, cnt2 As Long

    'Row and Column Initialization
    r = 1
    c = 1

    'Calculate Last Row and Last Column of Sheet
    mylr = Cells(Rows.Count, 1).End(xlUp).row
    lcol = Cells(1, Columns.Count).End(xlToLeft).column

    arrValues = Range(Cells(r, c), Cells(mylr, lcol))

    str = "M1" ' -> This i am interested in.Only these records will be populated

    For y = LBound(arrValues) To UBound(arrValues)  'Iterate through values
        If Left(arrValues(y, 1), 2) = str Then      'Check if the correct value exists
            cnt = cnt + 1                           'Count the number of occurences
        End If
    Next y

    'Initialize the Array according to Results Dimentions
    ReDim valarr(1 To cnt, 1 To lcol) 'Declare Array to be of size of Sheet

    cnt2 = 1                                        'Start at one to match the array of the values, but... feel free to change
    For y = LBound(arrValues) To UBound(arrValues)  'Iterate through array rows
        If Left(arrValues(y, 1), 2) = str Then      'Check if the correct value exists
            For z = LBound(arrValues, 2) To UBound(arrValues, 2)    'Iterate through array columns
                valarr(cnt2, z) = arrValues(y, z)                   'Add to the arr only correct values
            Next z
        cnt2 = cnt2 + 1                                             'If value find, we increase the counter
        End If
    Next y

End Sub