我真的很感谢我能为此提供的任何帮助。
我正在尝试遍历一列以查找重复的名称,然后从同一行中获取该名称和其他一些数据,并将它们放入要使用其他功能的2D数组中,但是它不起作用。
我真的需要您的帮助,弄清楚为什么我不保存数据就无法重新数组化。
Dim oRange As Range, aCell As Range, bCell As Range
Dim ws As Worksheet
Dim SearchString As String, FoundAt As String
Dim tArray() As Variant
Dim iR As Long
Dim LastRow As Long
Dim LastCol As Long
'name of the worksheet
Set ws = Worksheets("VML Daily")
'column 6 has a huge list of names
Set oRange = ws.Columns(6)
'the keyword (there are 7 'ABC Company 1' in the column above)
SearchString = "ABC Company 1"
'Find keyword in column
Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
'find last row and column number
LastRow = Range("A1").End(xlDown).Row
'redimensioning based on maximum rows
ReDim Preserve tArray(1 To LastRow, 1 To 3) As Variant
'if search finds something
If Not aCell Is Nothing Then
Set bCell = aCell
FoundAt = aCell.Address
iR = 1
tArray(1, 1) = aCell
tArray(1, 2) = aCell.Offset(0, 33)
tArray(1, 3) = aCell.Offset(0, 38)
'continue finding stuff until end
Do
Set aCell = oRange.FindNext(After:=aCell)
If Not aCell Is Nothing Then
If aCell.Address = bCell.Address Then Exit Do
FoundAt = FoundAt & ", " & aCell.Address
tArray(iR, 1) = aCell
tArray(iR, 2) = aCell.Offset(0, 33)
tArray(iR, 3) = aCell.Offset(0, 38)
iR = iR + 1
Else
Exit Do
End If
Loop
'redim'ing the array to the amount of hits I found above and preserve the data
'Here's where it error's out as "Subscript out of range"
ReDim Preserve tArray(1 To iR, 1 To 3) As Variant
Else
MsgBox SearchString & " not Found"
Exit Sub
End If
您的第二个Redim不起作用,因为您无法执行任何操作。
重新定义多维数组时,如果要保留值,则只能增加最后一个维。
在调用数组的同时更改数组的第一个元素Preserve
总是会导致下标超出范围错误。
Sub Example()
Dim val() As Variant
ReDim val(1 To 2, 1 To 3)
ReDim Preserve val(1 To 2, 1 To 4) 'Fine
ReDim Preserve val(1 To 2, 1 To 2) 'also Fine
ReDim Preserve val(1 To 3, 1 To 3) 'Throws error
ReDim Preserve val(1 To 1, 1 To 3) 'Also throws error
End Sub
编辑:由于您实际上并未更改最后一个尺寸,因此可以通过交换要更改的尺寸来简单地修改代码。
例如:
ReDim Preserve tArray(1 To LastRow, 1 To 3) As Variant
和
ReDim Preserve tArray(1 To iR, 1 To 3) As Variant
成为
ReDim Preserve tArray(1 To 3, 1 To LastRow) As Variant
和
ReDim Preserve tArray(1 To 3, 1 To iR) As Variant
您只需要交换您在每次通话中使用的号码,即可正常使用。像这样:
tArray(1, iR) = aCell
tArray(2, iR) = aCell.Offset(0, 33)
tArray(3, iR) = aCell.Offset(0, 38)
本文收集自互联网,转载请注明来源。
如有侵权,请联系[email protected] 删除。
我来说两句