Arrays 数组循环，为每个循环添加越来越多的数据

得到这个VBA：

Sub HenteDataFraSkjema1()

Dim wbThis                  As Workbook
Dim wbTarget                As Workbook
Dim sht1 As Worksheet
Dim Data() As Variant
Dim i As Integer
    
Set wbThis = ActiveWorkbook
Set sht1 = wbThis.Sheets("Ark1")
Folder = "H:\Mine dokumenter\Nedlastinger\Rapporter\"
Fname = Dir(Folder)

Do While Fname <> ""

  Set wbTarget = Workbooks.Open(Filename:=Folder & Fname)
  Set wsData = ThisWorkbook.Sheets("Ark1")
  
    Dim DataEntry As Range
    Set DataEntry = wbTarget.Sheets(1).Range("B3,G3,B7,R7")

            If Len(DataEntry.Cells(1, 1).Value) > 0 Then
                For Each Item In DataEntry
                    i = i + 1
                    ReDim Preserve Data(1 To i)
                    Data(i) = Item.Value
                Next
        
        wsData.Cells(wsData.Cells(wsData.Rows.Count, "A").End(xlUp).Row + 1, 1).Resize(1, i).Value = Data
            
            End If
 
Fname = Dir

wbTarget.Close True
        
Loop

End Sub

Sub-HenteDataFraSkjema1（）
将此设置为工作簿
将目标设置为工作簿
Dim sht1作为工作表
Dim Data（）作为变量
作为整数的Dim i
设置wbThis=ActiveWorkbook
设置sht1=wbThis.Sheets（“Ark1”）
Folder=“H:\Mine-dokumenter\Nedlastinger\Reporter\”
Fname=Dir（文件夹）
当Fname“”时执行
设置wbTarget=Workbooks.Open（文件名：=文件夹&Fname）
设置wsData=thiswoolk.Sheets（“Ark1”）
作为范围的Dim数据输入
设置数据项=wbTarget.Sheets（1）.范围（“B3、G3、B7、R7”）
如果Len（DataEntry.Cells（1，1.Value）>0，则
对于数据项中的每个项
i=i+1
ReDim保留数据（1到i）
数据（i）=项目价值
下一个
wsData.Cells（wsData.Cells（wsData.Rows.Count，“A”）.End（xlUp）.行+1，1）.调整大小（1，i）.值=数据
如果结束
Fname=Dir
wbTarget，关闭True
环
端接头

我试图扫描文件夹中的所有文件（250个！），从文件中的B3、G3、B7、R7复制数据，并将数据粘贴到A1、B1、C1、D1中的wbThis中。在下一个可用行中，将下一个文件放入wbThis。 VBA复制正常，但每次运行都会生成数据。在2号文件中，它将数据粘贴到单元格B2、B2、C2、D2、E2、F2、G2、H2中。B2:D2中的数据与从1号文件复制的数据相同。

---

发生了什么事？如何防止数组执行此操作？

您的变量

I

永远不会重置为零-因此，对于您打开的每个新工作簿，它只会向同一数组添加越来越多的数据

在循环结束之前，插入这些行

ReDim Data(1 to 1) '  Empties current data from the array, so it won't get re-used
i = 0              '  Empties the i variable so next sheet's data gets copied to 
                   '    the correct columns (starting at column A)

---

随着循环的每次迭代，您的数组越来越大。我看不出有什么必要。工作得很好！：-）