如何使用循环将值赋给数组

我想要使​​用循环从一个表中分配值

我尝试使用这个，但给错误“下标超出范围”

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 

我尝试了两种初始化方式，但都没有工作

初始化types1

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

初始化types2

 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将它们裁减到最小。 在你的情况下，我会在进入循环之前重新设定数组（甚至 – 为什么不先把它们变成正确的大小？）。 另外 – 在每个范围前加适当的工作表variables，而不是依次激活每个范围。 就像是：

 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提出了一个“types”的错误。 消除这使得代码运行没有错误 – 我怀疑错误消息是不正确的。

顺便说一句，还有一个陷阱（这不会导致运行时错误，至less不会显示的代码）：
Dim i, j, k, m As Long Dim ws, wcon, wcd, wj As Worksheet
不会将i, j, k声明为整型，而是作为变体。 ws, wcon, wcd是变体而不是工作表对象。