как присвоить значение массивов с помощью цикла

Question

Я хочу, чтобы присвоить значения массивов из листа с использованием цикла

Я попытался использовать это, но дает ошибку «выходу за пределы»

i=1 
With ws 
     Do While i <= 40 
      ReDim Preserve WorkID(1 To i) 
      ReDim Preserve Work(1 To i) 
      ReDim Preserve ComposerName(1 To i) 

      WorkID(i) = Range("A" & i + 1).Value 
      Work(i) = Range("B" & i + 1).Value 
      ComposerName(i) = Range("C" & i + 1).Value 
     i = i + 1 
     Loop 
    End With 

Я попробовал оба способа инициализации, но ни один из них не работал

Initialize Тип 1

Dim WorkID() As Variant    
Dim Work() As Variant     
Dim ComposerName() As Variant 

Initialize Тип 2

Dim WorkID(1 to 40) As Variant    
Dim Work(1 to 40) As Variant     
Dim ComposerName(1 to 40) As Variant 

Также я пытался без Redim, а как это, но ничего не получалось:

i=1 
    With ws 
     Do While i <= 40 
      WorkID(i) = Range("A" & i + 1).Value 
      Work(i) = Range("B" & i + 1).Value 
      ComposerName(i) = Range("C" & i + 1).Value 
     i = i + 1 
     Loop 
    End With 

Full Sub здесь:

Option Explicit 
Sub Join() 

Dim WorkID()    'Stores the workID from Works Sheet 
Dim Work()     'Stores the work from Works Sheet 
Dim ComposerName()  'Stores the composer from Works Sheet 
Dim ConductorID()   'Stores the ConductorID from Conductors Sheet 
Dim ConductorNames()  'Stores Conductor Names from Conductors Sheet 
Dim CDWorkID()   'Stores CDWorkID from CD Sheet 
Dim CDCondID()     'Stores CDConductor ID from CD Sheet 

Dim i, j, k, m As Long 
Dim ws, wcon, wcd, wj As Worksheet 

Set ws = Sheets("Works") 
Set wcon = Sheets("Conductors") 
Set wcd = Sheets("CDs") 
Set wj = Sheets("Join") 

i = j = k = 1         'Initalize 

ws.Activate 

     Do While i <= 40 
      ReDim Preserve WorkID(1 To i) 
      ReDim Preserve Work(1 To i) 
      ReDim Preserve ComposerName(1 To i) 

      WorkID(i) = Range("A" & i + 1).Value 
      Work(i) = Range("B" & i + 1).Value 
      ComposerName(i) = Range("C" & i + 1).Value 
     i = i + 1 
     Loop 

wcon.Activate 
     Do While j <= 10 
      ReDim Preserve ConductorID(1 To j) 
      ReDim Preserve ConductorNames(1 To j) 
      ConductorID(j) = Range("A" & j + 1).Value 
      ConductorNames(j) = Range("B" & j + 1).Value 
      j = j + 1 
     Loop 

wcd.Activate 

     Do While k <= 132 
      ReDim Preserve CDWorkID(1 To k) 
      ReDim Preserve CDCondID(1 To k) 
      CDWorkID(k) = Range("A" & k + 1).Value 
      CDCondID(k) = Range("B" * k + 1).Value 
     k = k + 1 
     Loop 

wj.Activate  
     For i = LBound(CDWorkID) To UBound(CDWorkID) 
     Range("F" & i) = CDWorkID(i) 
     Next i 

End Sub 

Answer 1

RedDim Preserve обычно является дорогостоящей операцией, так как она включает в себя выделение пространства для большего массива и перемещение содержимого из старого массива. Почти всегда плохая идея использовать его внутри цикла. Вместо этого - заранее определите, насколько велики должны быть массивы и ReDim только один раз. Если вы не знаете заранее, сделайте их больше, чем нужно, а затем используйте ReDim Preserve после цикла, чтобы обрезать их до размера. В вашем случае я бы переделал массивы перед входом в циклы (или даже - почему бы не Dim их правильного размера для начала?). Также - префикс каждого диапазона с соответствующей переменной рабочего листа, а не по очереди. Что-то вроде:

Sub Join() 

Dim WorkID()    'Stores the workID from Works Sheet 
Dim Work()     'Stores the work from Works Sheet 
Dim ComposerName()  'Stores the composer from Works Sheet 
Dim ConductorID()   'Stores the ConductorID from Conductors Sheet 
Dim ConductorNames()  'Stores Conductor Names from Conductors Sheet 
Dim CDWorkID()   'Stores CDWorkID from CD Sheet 
Dim CDCondID()     'Stores CDConductor ID from CD Sheet 

Dim i As Long 
Dim ws, wcon, wcd, wj As Worksheet 

Set ws = Sheets("Works") 
Set wcon = Sheets("Conductors") 
Set wcd = Sheets("CDs") 
Set wj = Sheets("Join") 

ReDim WorkID(1 To 40) 
ReDim Work(1 To 40) 
ReDim ComposerName(1 To 40) 
For i = 1 To 40 
    WorkID(i) = ws.Range("A" & i + 1).Value 
    Work(i) = ws.Range("B" & i + 1).Value 
    ComposerName(i) = ws.Range("C" & i + 1).Value 
Next i 

ReDim ConductorID(1 To 10) 
ReDim ConductorNames(1 To 10) 
For i = 1 To 10 
    ConductorID(i) = wcon.Range("A" & i + 1).Value 
    ConductorNames(i) = wcon.Range("B" & i + 1).Value 
Next i 

ReDim CDWorkID(1 To 132) 
ReDim CDCondID(1 To 132) 
For i = 1 To 132 
    CDWorkID(k) = wcd.Range("A" & i + 1).Value 
    CDCondID(k) = wcd.Range("B" & i + 1).Value 
Next i 

For i = LBound(CDWorkID) To UBound(CDWorkID) 
    wj.Range("F" & i) = CDWorkID(i) 
Next i 

End Sub 

Answer 2

Range("B" * k + 1).Value имеет опечатку - вы имели в виду Range("B" & k + 1).Value. Это приводит к тому, что range вызывает ошибку типа. Устранение этого означает, что код работает без ошибок - я подозреваю, что сообщение об ошибке неверно.

Кстати, есть еще один подводный камень (который не приводит к ошибке во время выполнения, по крайней мере, для кода показан):
Dim i, j, k, m As Long Dim ws, wcon, wcd, wj As Worksheet
НЕ будет объявить i, j, k как целое число, но как варианты. То же самое для ws, wcon, wcd, которые являются вариантами и не являются листами.