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

2次元配列が必要です。1つのディメンションを値に使用し、もう1つのディメンションを行に使用します。これが例です

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 に答える