VBA - 将数据从存储阵列复制到 sheet 阵列时出现问题
VBA - problem copying data from storage array to sheet array
我正在尝试在 VBA 中复制数据 Table 在 excel 中所做的事情。到目前为止,我已经让代码按我想要的方式工作,但是当我从临时存储阵列中复制数据时,它会偏移 1 列和 1 行。
我无法弄清楚问题出在哪里?提前致谢。
Sub DataTableLoop()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim CodeRng As Range
Dim PasteRng As Range
Dim WatchRng As Range
Dim ResultRng As Range
Dim ResultRes As Range
Dim x As Integer
Dim y As Integer
Dim i As Integer
Dim Count As Integer
Dim col As Integer
Dim MyArray As Variant
Dim TempArr As Variant
Dim CodeVar As Range
Set CodeRng = Worksheets("OptionCodes").[CodeTop]
Set PasteRng = Worksheets("OptionCodes").[OptionsCode]
Set WatchRng = Worksheets("OptionCodes").[WatchRange]
Set ResultRng = Worksheets("OptionCodes").[ResultsRange]
col = WatchRng.Columns.Count
x = Worksheets("OptionCodes").[Iterations].Value
y = x - 1
i = 0
Set ResultRes = ResultRng.Resize(x)
ReDim MyArray(x, col)
Do While i <= y
Set CodeVar = CodeRng.Offset(i, 0)
Count = i + 1
Application.StatusBar = "Iteration: " & Count & " of " & x
CodeVar.Copy
PasteRng.PasteSpecial Paste:=xlPasteValues
Application.Calculate
TempArr = WatchRng
For j = 1 To col
MyArray(Count, j) = TempArr(1, j)
Next j
i = i + 1
Loop
ResultRes = MyArray
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Redim
默认基于 0,因此您的数组实际上比您预期的大 1 行和 1 列。要以 1 为基础,您需要指定下限
ReDim MyArray(1 To x, 1 To col)
我正在尝试在 VBA 中复制数据 Table 在 excel 中所做的事情。到目前为止,我已经让代码按我想要的方式工作,但是当我从临时存储阵列中复制数据时,它会偏移 1 列和 1 行。
我无法弄清楚问题出在哪里?提前致谢。
Sub DataTableLoop()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim CodeRng As Range
Dim PasteRng As Range
Dim WatchRng As Range
Dim ResultRng As Range
Dim ResultRes As Range
Dim x As Integer
Dim y As Integer
Dim i As Integer
Dim Count As Integer
Dim col As Integer
Dim MyArray As Variant
Dim TempArr As Variant
Dim CodeVar As Range
Set CodeRng = Worksheets("OptionCodes").[CodeTop]
Set PasteRng = Worksheets("OptionCodes").[OptionsCode]
Set WatchRng = Worksheets("OptionCodes").[WatchRange]
Set ResultRng = Worksheets("OptionCodes").[ResultsRange]
col = WatchRng.Columns.Count
x = Worksheets("OptionCodes").[Iterations].Value
y = x - 1
i = 0
Set ResultRes = ResultRng.Resize(x)
ReDim MyArray(x, col)
Do While i <= y
Set CodeVar = CodeRng.Offset(i, 0)
Count = i + 1
Application.StatusBar = "Iteration: " & Count & " of " & x
CodeVar.Copy
PasteRng.PasteSpecial Paste:=xlPasteValues
Application.Calculate
TempArr = WatchRng
For j = 1 To col
MyArray(Count, j) = TempArr(1, j)
Next j
i = i + 1
Loop
ResultRes = MyArray
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Redim
默认基于 0,因此您的数组实际上比您预期的大 1 行和 1 列。要以 1 为基础,您需要指定下限
ReDim MyArray(1 To x, 1 To col)