Excel 在运行时获取数据

Excel 在运行时获取数据,excel,vba,Excel,Vba,我必须将图纸行捕获到二维数组中。我正在使用以下代码 代码: 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 Cou

我必须将图纸行捕获到二维数组中。我正在使用以下代码

代码:

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
但此代码填充错误。有什么问题

请参考工作表的样本图像


提前感谢

这个答案只解决了将范围放入二维阵列的问题,而不是元素的处理问题。

这段代码是一种非常有效的方法:

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

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

使用自动筛选(请参见代码中的注释):


请看下面的吼声,希望能有所帮助

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

使用自动过滤器不是更好吗?
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