我有一个简单的循环脚本,该脚本可以在所有带有扩展名.xlsx
的文件中移动,看来这样做很好,直到我注意到它在varArray
中存储了重复项,而它们没有存在于文件中。
任何想法可能是由什么引起的吗?我正在将数据编译到数组中,每个文件有1-4个工作表,因此这就是每个ws /下一个ws的总体功能。
Option Explicit
Sub Sharepoint_Merge()
Dim k As Long, x As Long, j As Long ' counters
Dim varArray() As Variant
Dim varArray2() As Variant
ReDim varArray(1 To 31, 1 To 1)
Dim folderPath As String, filepath As String, filename As String
Dim Wb As Workbook
Dim ws As Worksheet
folderPath = "C:\merge\"
filepath = folderPath & "*.xlsx"
filename = Dir(filepath)
Call Ludicrous(True)
Do While filename <> ""
Set Wb = Workbooks.Open(folderPath & filename)
For Each ws In Worksheets
For j = 2 To ActiveSheet.UsedRange.Rows.Count + 1
If ActiveSheet.Cells(j, 1) <> "" Then
x = x + 1
ReDim Preserve varArray(1 To UBound(varArray, 1), 1 To x)
For k = 1 To UBound(varArray, 1)
varArray(k, x) = ActiveSheet.Cells(j, k)
Next
End If
Next
Next ws
Wb.Close
filename = Dir
Loop
ReDim varArray2(1 To UBound(varArray, 2), 1 To UBound(varArray, 1))
With ThisWorkbook.Worksheets("Merged Files")
For j = 1 To UBound(varArray, 2)
For k = 1 To UBound(varArray, 1)
varArray2(j, k) = varArray(k, j)
Next
Next
.Range(.Cells(2, 1), .Cells(UBound(varArray, 2), UBound(varArray, 1))) = varArray2
End With
Call Ludicrous(False)
End Sub