0

我编写了一段简单的代码，它基本上扫描 A 列，检测条件，一旦连续满足条件，它将同一行的 B 列中的单元格复制到一个数组中。我希望有人可以帮助我制作一个嵌套数组，它不仅可以将值存储在 B 列中，还可以存储它的行数。这是我到目前为止所拥有的，任何帮助表示赞赏。

Dim col2 As Range
Dim cell2 As Excel.Range
Dim rowcount2 As Integer
Dim ii As Integer

ii = 0
rowcount2 = DataSheet.UsedRange.Rows.Count
Set col2 = DataSheet.Range("A1:A" & rowcount2)
Dim parsedcell() As String
Dim oldarray() As String

    For Each cell2 In col2

        If cell2.Value <> Empty Then
            parsedcell = Split(cell2.Value, "$")
            sheetName = parsedcell(0)

                If sheetName = DHRSheet.Name Then

                    Dim oldvalue As Range
                    ReDim Preserve oldarray(ii)
                    Set oldvalue = DataSheet.Cells(cell2.Row, 2)

                    oldarray(ii) = oldvalue.Value

                    ii = ii + 1

                End If

      End If

    Next
4

2 回答 2

0

你需要一个二维数组。对值使用一个维度，对行使用另一个维度。这是一个例子

Sub GetArray()

    Dim vaInput As Variant
    Dim rRng As Range
    Dim aOutput() As Variant
    Dim i As Long
    Dim lCnt As Long

    'Define the range to test
    Set rRng = DataSheet.Range("A1", DataSheet.Cells(DataSheet.Rows.Count, 1).End(xlUp)).Resize(, 2)
    'Put the values in that range into an array
    vaInput = rRng.Value

    'Lopo through the array
    For i = LBound(vaInput, 1) To UBound(vaInput, 1)
        'Skip blank cells
        If Len(vaInput(i, 1)) > 0 Then
            'Test for the sheet's name in the value
            If Split(vaInput(i, 1), "$")(0) = DHRSheet.Name Then
                'Write the value and row to the output array
                lCnt = lCnt + 1
                'You can only adjust the second dimension with a redim preserve
                ReDim Preserve aOutput(1 To 2, 1 To lCnt)
                aOutput(1, lCnt) = vaInput(i, 2) 'write the value
                aOutput(2, lCnt) = i 'write the row count
            End If
        End If
    Next i

    'Output to see if you got it right
    For i = LBound(aOutput, 2) To UBound(aOutput, 2)
        Debug.Print aOutput(1, i), aOutput(2, i)
    Next i

End Sub
于 2012-08-02T16:33:00.580 回答
0 
Dim col2 As Range
Dim cell2 As Excel.Range
Dim rowcount2 As Integer
Dim arr() As Variant
Dim p As Integer
p = 0

rowcount2 = DataSheet.UsedRange.Rows.Count
Set col2 = DataSheet.Range("A1:A" & rowcount2)
Dim parsedcell() As String


    For Each cell2 In col2

        If cell2.Value <> Empty Then
            parsedcell = Split(cell2.Value, "$")
            sheetName = parsedcell(0)

                If sheetName = DHRSheet.Name Then
                    Dim subarr(1) As Variant
                    Dim oldvalue As Range

                    ReDim Preserve arr(p)


                    Set oldvalue = DataSheet.Cells(cell2.Row, 2)

                    subarr(0) = oldvalue.Value
                    subarr(1) = cell2.Row
                    arr(p) = subarr
                    p = p + 1

                    'MsgBox (oldvalue)

                End If

      End If

    Next
于 2012-08-03T18:35:31.250 回答