我编写了一段简单的代码,它基本上扫描了A列,检测了一个条件,一旦连续满足条件,它就会将同一行B列中的单元格复制到一个数组中。我希望有人可以帮我创建一个嵌套数组,它不仅可以存储B列中的值,还可以存储其rowcount。这是我到目前为止,任何帮助表示赞赏。
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
答案 0 :(得分: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
答案 1 :(得分: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