为每个循环添加越来越多数据的数组循环答案

【问题标题】：Array Loop that adds more and more data for each loop为每个循环添加越来越多数据的数组循环
【发布时间】：2020-10-07 08:39:35
【问题描述】：

得到这个 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

我正在尝试扫描文件夹中的所有文件（其中 250 个！），从文件中的 B3、G3、B7、R7 复制数据，并将数据粘贴到 A1、B1、C1、D1 中的 wbThis 中。下一个可用行中的下一个文件到 wbThis。 VBA 复制没问题，但每次运行都会建立数据。在文件 2 上，它将数据粘贴到 wbThis 到单元格 B2、B2、C2、D2、E2、F2、G2、H2 中。 B2:D2 中的数据与从 1 号文件复制的数据相同。怎么了？我怎样才能防止数组这样做？

【问题讨论】：

您的数组会随着循环的每次迭代而变得越来越大。反正我觉得没必要。

标签： arrays excel vba loops copy-paste

【解决方案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)

【讨论】：

工作完美！ :-)