-1
我有一個通過多個文件（> 100）的代碼。它打開文件，並將該信息放入數組中。在每個新文件中，行中的項目數可能會發生變化（增加或減少）。我使用第二個數組來說明這一點。查看數組中的列並複製數據
列標題也會在文件中更改（不同列位置中的標題）。我的問題是我正在嘗試通過第一行（標題）上的列，看看它們是否在該文件數組中，如果它們是，將該信息複製到輸出文件（如果它們不是，請將「 - 「）。
當前的代碼：
Sub Price()
Dim w As Workbook
Dim w2 As Workbook
Dim start1 As Long, end1 As Long, i As Long, lRow As Long, lColumn As Long, t As Long, k As Long, position As Long, g As Long, p As Long, u As Long
Dim WBArray() As Variant
Dim r As Range
Dim Header(): ReDim Header(0)
Dim IS3(): ReDim IS3(0) 'this fix the subscript out of range error
Dim ws As Worksheet
Dim MyFolder As String
Dim MyFile As String
Set w = ThisWorkbook
'clean all worksheets in the main file (except FILES)
For Each ws In w.Worksheets
If ws.Name <> "FILES" Then
ws.UsedRange.ClearContents
End If
Next ws
'Optimize Macro Speed Start
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
'opens the first workbook file
For i = 2 To ThisWorkbook.Sheets("FILES").Cells(1, 2).Value
Workbooks.Open Filename:=ThisWorkbook.path & "\" & ThisWorkbook.Sheets("FILES").Cells(i, 1).Value
Set w2 = ActiveWorkbook
ActiveSheet.Range("A:A").Select
'text to columns
Selection.TextToColumns destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=True, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7 _
, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17 _
, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), Array(27 _
, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1)), TrailingMinusNumbers:=True
'create the array based on whanted data
With ActiveSheet
Set r = .Columns(1).Find(what:="ISIN", After:=.Cells(.Rows.count, 1), lookat:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not r Is Nothing Then
start1 = r.Row
end1 = .Range("B" & Rows.count).End(xlUp).Row
WBArray = .Range(Cells(start1, 1), Cells(end1, 29)).Value
End If
End With
'loop to match information in two arrays
'option 1 ***************************************
For lColumn = 2 To UBound(WBArray)
If IsInArray((WBArray(1, lColumn)), Header) <> -1 Then
p = IsInArray((WBArray(1, lColumn)), Header)
'p is position when already in array
Else
ReDim Preserve Header(LBound(Header) To UBound(Header) + 1)
Header(UBound(Header)) = WBArray(1, lColumn)
u = UBound(Header)
'u is position when not in array, redim to end
End If
Next lColumn
For lRow = 2 To UBound(WBArray)
For lColumn = 2 To UBound(WBArray)
If IsInArray((WBArray(lRow, 1)), IS3) <> -1 Then
t = IsInArray((WBArray(lRow, 1)), IS3)
If lColumn.Name = "Cpn" Then
w.Sheets("Cpn").Cells(t, i + 3).Value = WBArray(lRow, lColumn)
Else
'w.Sheets("Cpn").Cells(t, i + 3).Value = "--"
Resume Next
End if
w.Sheets("M").Cells(t, i + 3) = WBArray(lRow, lColumn)
w.Sheets("W t-1").Cells(t, i + 3) = WBArray(lRow, lColumn)
w.Sheets("P").Cells(t, i + 3) = WBArray(lRow, lColumn)
w.Sheets("A").Cells(t, i + 3) = WBArray(lRow, lColumn)
w.Sheets("PC").Cells(t, i + 3) = WBArray(lRow, lColumn)
w.Sheets("AM").Cells(t, i + 3) = WBArray(lRow, lColumn)
w.Sheets("AM t-1").Cells(t, i + 3) = WBArray(lRow, lColumn)
w.Sheets("Pe t-1").Cells(t, i + 3) = WBArray(lRow, lColumn)
w.Sheets("F").Cells(t, i + 3) = WBArray(lRow, lColumn)
w.Sheets("F t-1").Cells(t, i + 3) = WBArray(lRow, lColumn)
w.Sheets("A t-1").Cells(t, i + 3) = WBArray(lRow, lColumn)
w.Sheets("S").Cells(t, i + 3) = WBArray(lRow, lColumn)
Else
'add it to the end of IS3Array
ReDim Preserve IS3(LBound(IS3) To UBound(IS3) + 1)
IS3(UBound(IS3)) = WBArray(lRow, 1)
k = UBound(IS3)
w.Sheets("C").Cells(k + 1, i + 3) = WBArray(lRow, lColumn)
w.Sheets("M").Cells(k + 1, i + 3) = WBArray(lRow, lColumn)
w.Sheets("W t-1").Cells(k + 1, i + 3) = WBArray(lRow, lColumn)
w.Sheets("P").Cells(k + 1, i + 3) = WBArray(lRow, lColumn)
w.Sheets("A").Cells(k + 1, i + 3) = WBArray(lRow, lColumn)
w.Sheets("PC").Cells(k + 1, i + 3) = WBArray(lRow, lColumn)
w.Sheets("AM").Cells(k + 1, i + 3) = WBArray(lRow, lColumn)
w.Sheets("AM t-1").Cells(k + 1, i + 3) = WBArray(lRow, lColumn)
w.Sheets("P t-1").Cells(k + 1, i + 3) = WBArray(lRow, 17)
w.Sheets("F").Cells(k + 1, i + 3) = WBArray(lRow, lColumn)
w.Sheets("F t-1").Cells(k + 1, i + 3) = WBArray(lRow, lColumn)
w.Sheets("A t-1").Cells(k + 1, i + 3) = WBArray(lRow, 18)
w.Sheets("S").Cells(k + 1, i + 3) = WBArray(lRow, lColumn)
End If
Next lColumn
Next lRow
'copy the file date from each source workbook to output workbook
'if the control sheet name (FILES) is changed, please change it in this loop
For Each ws In w.Worksheets
If ws.Name <> "FILES" Then
ws.Cells(1, i + 3) = w2.Worksheets(1).Cells(1, 2)
End If
Next ws
'Close file And Save
w2.Close True
Next i
'paste the is3 array to all worksheets
g = UBound(IS3)
For Each ws In w.Worksheets
If ws.Name <> "FILES" Then
ws.Range("A1:A" & g).Value = Application.WorksheetFunction.Transpose(IS3)
End If
Next ws
'Optimize Macro Speed
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
End Function
Public Function IsInArray(stringToBeFound As String, Arr As Variant) As Long
Dim position As Long
'default return value if value not found in array
IsInArray = -1
If IsArrayEmpty(Arr) Then Exit Function
For position = LBound(Arr) To UBound(Arr) 'subscript out of range
If Arr(position) = stringToBeFound Then
IsInArray = position + 1
Exit For
End If
Next
End Function
Public Function IsArrayEmpty(Arr As Variant) As Boolean
Dim LB As Long
Dim UB As Long
Err.Clear
On Error Resume Next
If IsArray(Arr) = False Then
IsArrayEmpty = True
End If
' Attempt to get the UBound of the array. If the array is unallocated, an error will occur.
UB = UBound(Arr, 1)
If (Err.Number <> 0) Then
IsArrayEmpty = True
Else
Err.Clear
LB = LBound(Arr)
If LB > UB Then
IsArrayEmpty = True
Else
IsArrayEmpty = False
End If
End If
End Function
任何想法？
感謝您的回答。顯然，解決這個問題的最好方法是在粘貼循環之前聲明變量。這樣它運行時不會過度迭代。我粘貼了這部分代碼作爲答案。 – DGMS89