Arrays Excel VBA-将数据写入数组不'；行不通
今天我开始学习VBA中的数组 在尝试了一些简单的脚本之后，我想创建一个对我的项目有用的脚本 在我的Excel工作表中，我有一个需要转换为新工作表的数据表。仅适用于第4行中包含“详细信息”的每列 最简单的方法是将每个相关列的值写入数组，将结果读写到新的工作表，然后再次执行该操作 但我认为我使用了一种错误的方法将变量写入数组。 我查看了我的代码，发现所有的偏差都不正确 你能帮我一下吗，我怎样才能把写的内容改成正确的数组Arrays Excel VBA-将数据写入数组不'；行不通,arrays,vba,excel,Arrays,Vba,Excel,今天我开始学习VBA中的数组 在尝试了一些简单的脚本之后，我想创建一个对我的项目有用的脚本 在我的Excel工作表中，我有一个需要转换为新工作表的数据表。仅适用于第4行中包含“详细信息”的每列 最简单的方法是将每个相关列的值写入数组，将结果读写到新的工作表，然后再次执行该操作 但我认为我使用了一种错误的方法将变量写入数组。 我查看了我的代码，发现所有的偏差都不正确 你能帮我一下吗，我怎样才能把写的内容改成正确的数组 Sub Import_data() Dim LastCol As Intege
Sub Import_data()
Dim LastCol As Integer
Dim LastRow As Long
Dim WS As Worksheet
Dim Arr() As Variant
Dim dim1 As Long, dim2 As Long
Set WS = Sheets("Budget to Table")
' Copy data from Budget to Table
With WS
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
dim1 = .Cells(.Rows.Count, "B").End(xlUp).Row - 5
dim2 = 4
' Copy information
For i = 3 To LastCol
If Cells(4, i).Value = "Detail" Then
ReDim Arr(0 To dim1, 0 To dim2)
For dim1 = LBound(Arr, 1) To UBound(Arr, 1)
For dim2 = LBound(Arr, 2) To UBound(Arr, 2)
Arr(dim1, 0) = Range(Cells(dim1, 2)) 'Should have the variable length but always column B
Arr(dim1, 1) = Range(Cells(dim1, i)) 'Should have the variable length but always column i
Arr(dim1, 2) = Range(Cells(1, i)) 'Is always the same header info from row 1 of the chosen column
Arr(dim1, 3) = Range(Cells(2, i)) 'Is always the same header info from row 2 of the chosen column
Arr(dim1, 4) = Range(Cells(3, i)) 'Is always the same header info from row 3 of the chosen column
Next dim2
Next dim1
End If
'writing the contents in a new sheet
Worksheet.Add
For dim1 = LBound(Arr, 1) To UBound(Arr, 1)
For dim2 = LBound(Arr, 2) To UBound(Arr, 2)
ActiveCell.Offset(dim1, dim2).Value = Arr(dim1, dim2)
Next dim2
Next dim1
Erase Arr
Next i
End With
End Sub
dim1dim2提前谢谢 使用动态变量数组更简单
Sub Import_data()
Dim LastCol As Integer
Dim LastRow As Long
Dim WS As Worksheet
Dim Arr() As Variant, vDB As Variant
Dim i As Integer, j As Long, n As Long
Set WS = Sheets("Budget to Table")
' Copy data from Budget to Table
With WS
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
vDB = .Range("a1", .Cells(LastRow, LastCol)) '<~~ get data to vDB variant array from range
' Copy information
For i = 3 To LastCol
n = 0
If vDB(4, i) = "Detail" Then
For j = 5 To UBound(vDB, 1)
n = n + 1
ReDim Preserve Arr(1 To 5, 1 To n) '<~set dynamic variant array which is to be transposed.
Arr(1, n) = vDB(j, 2)
Arr(2, n) = vDB(j, i)
Arr(3, n) = vDB(1, i)
Arr(4, n) = vDB(2, i)
Arr(5, n) = vDB(3, i)
Next j
'writing the contents in a new sheet
Worksheets.Add after:=Sheets(Sheets.Count)
Range("a1").Resize(n, 5) = WorksheetFunction.Transpose(Arr)
ReDim Arr(1 To 5, 1 To 1)
End If
Next i
End With
End Sub
子导入_数据（）
将LastCol设置为整数
最后一排一样长
将WS设置为工作表
Dim Arr（）作为变量，vDB作为变量
Dim i为整数，j为长，n为长
设置WS=Sheets（“预算到表格”）
'将数据从预算复制到表
与WS
LastCol=.Cells（1，.Columns.Count）.End（xlToLeft）.Column
LastRow=.Cells（.Rows.Count，“B”）.End（xlUp）.Row
vDB=.Range（“a1”，.Cells（LastRow，LastCol））”使用动态变量数组更简单
Sub Import_data()
Dim LastCol As Integer
Dim LastRow As Long
Dim WS As Worksheet
Dim Arr() As Variant, vDB As Variant
Dim i As Integer, j As Long, n As Long
Set WS = Sheets("Budget to Table")
' Copy data from Budget to Table
With WS
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
vDB = .Range("a1", .Cells(LastRow, LastCol)) '<~~ get data to vDB variant array from range
' Copy information
For i = 3 To LastCol
n = 0
If vDB(4, i) = "Detail" Then
For j = 5 To UBound(vDB, 1)
n = n + 1
ReDim Preserve Arr(1 To 5, 1 To n) '<~set dynamic variant array which is to be transposed.
Arr(1, n) = vDB(j, 2)
Arr(2, n) = vDB(j, i)
Arr(3, n) = vDB(1, i)
Arr(4, n) = vDB(2, i)
Arr(5, n) = vDB(3, i)
Next j
'writing the contents in a new sheet
Worksheets.Add after:=Sheets(Sheets.Count)
Range("a1").Resize(n, 5) = WorksheetFunction.Transpose(Arr)
ReDim Arr(1 To 5, 1 To 1)
End If
Next i
End With
End Sub
子导入_数据（）
将LastCol设置为整数
最后一排一样长
将WS设置为工作表
Dim Arr（）作为变量，vDB作为变量
Dim i为整数，j为长，n为长
设置WS=Sheets（“预算到表格”）
'将数据从预算复制到表
与WS
LastCol=.Cells（1，.Columns.Count）.End（xlToLeft）.Column
LastRow=.Cells（.Rows.Count，“B”）.End（xlUp）.Row
vDB=.Range（“a1”，.Cells（LastRow，LastCol））”您的代码存在一些问题（请注意那些不合格的范围），但主要的问题是您的数组索引与单元格行和列引用混淆了，正如您所指出的，在对数组进行尺寸标注时，存在一些冗余代码<使用多维数组时，code>Redim Preserve
也受到限制
因此，下面是代码的修改版本，其中显示了所需的调整
但是，如果您想使用阵列，那么您可以更加高效。例如，您可以在一行代码中将范围读入数组并从数组写入范围（这比使用循环快得多）。第二段代码向您展示了一种更有效的处理任务的方法——我不确定您的示例行是否在列“a”中都有“Details”，因为如果它们没有中断，那么代码可能会更短
您修改的代码：
Dim dataWs As Worksheet, newWs As Worksheet
Dim lastRow As Long, lastCol As Long
Dim c As Long, r As Long, i As Long, j As Long
Dim arr() As Variant
'Read the data into an array
Set dataWs = ThisWorkbook.Worksheets("Budget to Table")
With dataWs
lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
'Loop through each of the data columns.
For c = 3 To lastCol
If Not IsEmpty(dataWs.Cells(3, c)) Then 'looks lik you only want the yellow columns.
'Dimension the array for number of rows
ReDim arr(1 To lastRow - 4, 1 To 5)
'Loop through each row in data array and transfer it.
With dataWs
For r = 5 To lastRow
arr(r - 4, 1) = .Cells(r, 2).Value
arr(r - 4, 2) = .Cells(r, c).Value
arr(r - 4, 3) = .Cells(1, c).Value
arr(r - 4, 4) = .Cells(2, c).Value
arr(r - 4, 5) = .Cells(3, c).Value
Next
End With
'Create a new sheet.
With ThisWorkbook.Worksheets
Set newWs = .Add(After:=.Item(.Count))
newWs.Name = arr(1, 5) 'name it for ease of use.
End With
'Write array onto the new sheet - the inefficient way
For i = 1 To UBound(arr, 1)
For j = 1 To UBound(arr, 2)
newWs.Cells(i, j).Value = arr(i, j)
Next
Next
End If
Next
Dim ws As Worksheet
Dim data As Variant, output() As Variant
Dim rowList As Collection
Dim c As Long, i As Long
Dim r As Variant
'Read the data into an array
With ThisWorkbook.Worksheets("Budget to Table")
data = .Range(.Range("A1"), _
.Range(.Cells(1, .Columns.Count).End(xlToLeft), _
.Cells(.Rows.Count, "B").End(xlUp))) _
.Value2
End With
'Find the first dimension indexes with "Detail" in column A.
'We'll create a collection of our target row numbers.
Set rowList = New Collection
For i = 1 To UBound(data, 1)
If data(i, 1) = "Detail" Then rowList.Add i
Next
'Loop through each of the data columns.
For c = 3 To UBound(data, 2)
If Not IsEmpty(data(3, c)) Then 'looks lik you only want the yellow columns.
'Dimension the array for number of rows
ReDim output(1 To rowList.Count, 1 To 5)
i = 1 'row index for output array
'Loop through each row in data array and transfer it.
For Each r In rowList
output(i, 1) = data(r, 2)
output(i, 2) = data(r, c)
output(i, 3) = data(1, c)
output(i, 4) = data(2, c)
output(i, 5) = data(3, c)
i = i + 1
Next
'Create a new sheet.
With ThisWorkbook.Worksheets
Set ws = .Add(After:=.Item(.Count))
ws.Name = output(1, 5) 'name it for ease of use.
End With
'Write array onto the new sheet.
ws.Range("A1").Resize(UBound(output, 1), UBound(output, 2)).Value = output
End If
Next
处理数组的另一种方式：
Dim dataWs As Worksheet, newWs As Worksheet
Dim lastRow As Long, lastCol As Long
Dim c As Long, r As Long, i As Long, j As Long
Dim arr() As Variant
'Read the data into an array
Set dataWs = ThisWorkbook.Worksheets("Budget to Table")
With dataWs
lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
'Loop through each of the data columns.
For c = 3 To lastCol
If Not IsEmpty(dataWs.Cells(3, c)) Then 'looks lik you only want the yellow columns.
'Dimension the array for number of rows
ReDim arr(1 To lastRow - 4, 1 To 5)
'Loop through each row in data array and transfer it.
With dataWs
For r = 5 To lastRow
arr(r - 4, 1) = .Cells(r, 2).Value
arr(r - 4, 2) = .Cells(r, c).Value
arr(r - 4, 3) = .Cells(1, c).Value
arr(r - 4, 4) = .Cells(2, c).Value
arr(r - 4, 5) = .Cells(3, c).Value
Next
End With
'Create a new sheet.
With ThisWorkbook.Worksheets
Set newWs = .Add(After:=.Item(.Count))
newWs.Name = arr(1, 5) 'name it for ease of use.
End With
'Write array onto the new sheet - the inefficient way
For i = 1 To UBound(arr, 1)
For j = 1 To UBound(arr, 2)
newWs.Cells(i, j).Value = arr(i, j)
Next
Next
End If
Next
Dim ws As Worksheet
Dim data As Variant, output() As Variant
Dim rowList As Collection
Dim c As Long, i As Long
Dim r As Variant
'Read the data into an array
With ThisWorkbook.Worksheets("Budget to Table")
data = .Range(.Range("A1"), _
.Range(.Cells(1, .Columns.Count).End(xlToLeft), _
.Cells(.Rows.Count, "B").End(xlUp))) _
.Value2
End With
'Find the first dimension indexes with "Detail" in column A.
'We'll create a collection of our target row numbers.
Set rowList = New Collection
For i = 1 To UBound(data, 1)
If data(i, 1) = "Detail" Then rowList.Add i
Next
'Loop through each of the data columns.
For c = 3 To UBound(data, 2)
If Not IsEmpty(data(3, c)) Then 'looks lik you only want the yellow columns.
'Dimension the array for number of rows
ReDim output(1 To rowList.Count, 1 To 5)
i = 1 'row index for output array
'Loop through each row in data array and transfer it.
For Each r In rowList
output(i, 1) = data(r, 2)
output(i, 2) = data(r, c)
output(i, 3) = data(1, c)
output(i, 4) = data(2, c)
output(i, 5) = data(3, c)
i = i + 1
Next
'Create a new sheet.
With ThisWorkbook.Worksheets
Set ws = .Add(After:=.Item(.Count))
ws.Name = output(1, 5) 'name it for ease of use.
End With
'Write array onto the new sheet.
ws.Range("A1").Resize(UBound(output, 1), UBound(output, 2)).Value = output
End If
Next
您的代码有一些问题（请注意那些不合格的范围），但最主要的一点是，数组索引与单元格行和列引用混淆，正如您所指出的，在对数组进行尺寸标注时，会有一些冗余代码。Redim Preserve
在使用多维数组时也受到限制
因此，下面是代码的修改版本，其中显示了所需的调整
但是，如果您想使用数组，那么您可以更高效。例如，您可以将范围读入数组，并在一行代码中从数组写入范围（这比使用循环快得多）.第二段代码向您展示了一种更有效的处理任务的方法-我不确定您的示例行是否在列“a”中都有“详细信息”，因为如果它们没有中断，那么代码可能会更短
您修改的代码：
Dim dataWs As Worksheet, newWs As Worksheet
Dim lastRow As Long, lastCol As Long
Dim c As Long, r As Long, i As Long, j As Long
Dim arr() As Variant
'Read the data into an array
Set dataWs = ThisWorkbook.Worksheets("Budget to Table")
With dataWs
lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
'Loop through each of the data columns.
For c = 3 To lastCol
If Not IsEmpty(dataWs.Cells(3, c)) Then 'looks lik you only want the yellow columns.
'Dimension the array for number of rows
ReDim arr(1 To lastRow - 4, 1 To 5)
'Loop through each row in data array and transfer it.
With dataWs
For r = 5 To lastRow
arr(r - 4, 1) = .Cells(r, 2).Value
arr(r - 4, 2) = .Cells(r, c).Value
arr(r - 4, 3) = .Cells(1, c).Value
arr(r - 4, 4) = .Cells(2, c).Value
arr(r - 4, 5) = .Cells(3, c).Value
Next
End With
'Create a new sheet.
With ThisWorkbook.Worksheets
Set newWs = .Add(After:=.Item(.Count))
newWs.Name = arr(1, 5) 'name it for ease of use.
End With
'Write array onto the new sheet - the inefficient way
For i = 1 To UBound(arr, 1)
For j = 1 To UBound(arr, 2)
newWs.Cells(i, j).Value = arr(i, j)
Next
Next
End If
Next
Dim ws As Worksheet
Dim data As Variant, output() As Variant
Dim rowList As Collection
Dim c As Long, i As Long
Dim r As Variant
'Read the data into an array
With ThisWorkbook.Worksheets("Budget to Table")
data = .Range(.Range("A1"), _
.Range(.Cells(1, .Columns.Count).End(xlToLeft), _
.Cells(.Rows.Count, "B").End(xlUp))) _
.Value2
End With
'Find the first dimension indexes with "Detail" in column A.
'We'll create a collection of our target row numbers.
Set rowList = New Collection
For i = 1 To UBound(data, 1)
If data(i, 1) = "Detail" Then rowList.Add i
Next
'Loop through each of the data columns.
For c = 3 To UBound(data, 2)
If Not IsEmpty(data(3, c)) Then 'looks lik you only want the yellow columns.
'Dimension the array for number of rows
ReDim output(1 To rowList.Count, 1 To 5)
i = 1 'row index for output array
'Loop through each row in data array and transfer it.
For Each r In rowList
output(i, 1) = data(r, 2)
output(i, 2) = data(r, c)
output(i, 3) = data(1, c)
output(i, 4) = data(2, c)
output(i, 5) = data(3, c)
i = i + 1
Next
'Create a new sheet.
With ThisWorkbook.Worksheets
Set ws = .Add(After:=.Item(.Count))
ws.Name = output(1, 5) 'name it for ease of use.
End With
'Write array onto the new sheet.
ws.Range("A1").Resize(UBound(output, 1), UBound(output, 2)).Value = output
End If
Next
处理数组的另一种方式：
Dim dataWs As Worksheet, newWs As Worksheet
Dim lastRow As Long, lastCol As Long
Dim c As Long, r As Long, i As Long, j As Long
Dim arr() As Variant
'Read the data into an array
Set dataWs = ThisWorkbook.Worksheets("Budget to Table")
With dataWs
lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
'Loop through each of the data columns.
For c = 3 To lastCol
If Not IsEmpty(dataWs.Cells(3, c)) Then 'looks lik you only want the yellow columns.
'Dimension the array for number of rows
ReDim arr(1 To lastRow - 4, 1 To 5)
'Loop through each row in data array and transfer it.
With dataWs
For r = 5 To lastRow
arr(r - 4, 1) = .Cells(r, 2).Value
arr(r - 4, 2) = .Cells(r, c).Value
arr(r - 4, 3) = .Cells(1, c).Value
arr(r - 4, 4) = .Cells(2, c).Value
arr(r - 4, 5) = .Cells(3, c).Value
Next
End With
'Create a new sheet.
With ThisWorkbook.Worksheets
Set newWs = .Add(After:=.Item(.Count))
newWs.Name = arr(1, 5) 'name it for ease of use.
End With
'Write array onto the new sheet - the inefficient way
For i = 1 To UBound(arr, 1)
For j = 1 To UBound(arr, 2)
newWs.Cells(i, j).Value = arr(i, j)
Next
Next
End If
Next
Dim ws As Worksheet
Dim data As Variant, output() As Variant
Dim rowList As Collection
Dim c As Long, i As Long
Dim r As Variant
'Read the data into an array
With ThisWorkbook.Worksheets("Budget to Table")
data = .Range(.Range("A1"), _
.Range(.Cells(1, .Columns.Count).End(xlToLeft), _
.Cells(.Rows.Count, "B").End(xlUp))) _
.Value2
End With
'Find the first dimension indexes with "Detail" in column A.
'We'll create a collection of our target row numbers.
Set rowList = New Collection
For i = 1 To UBound(data, 1)
If data(i, 1) = "Detail" Then rowList.Add i
Next
'Loop through each of the data columns.
For c = 3 To UBound(data, 2)
If Not IsEmpty(data(3, c)) Then 'looks lik you only want the yellow columns.
'Dimension the array for number of rows
ReDim output(1 To rowList.Count, 1 To 5)
i = 1 'row index for output array
'Loop through each row in data array and transfer it.
For Each r In rowList
output(i, 1) = data(r, 2)
output(i, 2) = data(r, c)
output(i, 3) = data(1, c)
output(i, 4) = data(2, c)
output(i, 5) = data(3, c)
i = i + 1
Next
'Create a new sheet.
With ThisWorkbook.Worksheets
Set ws = .Add(After:=.Item(.Count))
ws.Name = output(1, 5) 'name it for ease of use.
End With
'Write array onto the new sheet.
ws.Range("A1").Resize(UBound(output, 1), UBound(output, 2)).Value = output
End If
Next
从你的代码和描述中，我真的不明白你想做什么。但是，将范围写入VBA数组的常用方法是：Dim arr as Variant:arr=myRange
-->二维数组。请参阅Chip Pearson网页上的[VBA中的数组和范围]（VBA数组和工作表范围）。并且发布一个带注释的屏幕截图来准确显示您正在尝试执行的操作会很有帮助。如果您要传输到数组的范围是非连续的，那么您可以执行类似于Redim arr（1到.Areas.Count）
：对于每个W in.Areas:I=I+1:arr（I）=W.Value2`@RonRosenfeld我上载了该文件的信息（对其进行了命名），我还手动执行了两次最终结果，因此您可以获得一个想法。如果我需要提供任何其他东西，请让我知道和thnx的研究已经！您可能引用了错误的对象。您可以通过声明WS
开始，但稍后开始在omnipresent应用程序对象上使用默认属性。我的意思是在这句话中：LastCol=.Cells（1，.Columns.Count）.End（xlToLeft）.Column
，。Cells
来自WS
。但是在这条语句中：如果单元格（4，i）.Value=“Detail”那么，单元格是来自应用程序对象的。您对范围的使用同样值得怀疑。工作表中的工作表是什么。添加
？通常，工作表没有Add方法。要读取数组，请使用vals=Range（“A2”）.Resize（100,5）.Value
类型的语法，并使用Range（“A2”）.Resize（100,5）.Value=vals
将其反向写入。将带有Dim vals（）的数组声明为变量
，并确保大小类似于ReDim vals（1到100，1到5）
，其中1基于