我有一个代码经过多个文件（＆gt; 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
有什么想法吗？
答案 0 :(得分：0)
经过一番研究后，我发现最好的方法是不必遍历每个文件中每行的所有列，而不必创建任何Header数组，就是先说出我想要的变量，分配每个都是一个具有IsInArray函数的列。之后，我将IsInArray函数的结果分配给变量，并使用它粘贴到我的输出文件。 已更改的代码部分：
C = IsInArray2("C", WBArray)
M = IsInArray2("M", WBArray)
W0 = IsInArray2("W t-1", WBArray)
P = IsInArray2("P", WBArray)
Ac= IsInArray2("Ac, WBArray)
PC = IsInArray2("PC", WBArray)
AM = IsInArray2("AM", WBArray)
AM = IsInArray2("AM t-1", WBArray)
P = IsInArray2("Pt-1", WBArray)
F = IsInArray2("F", WBArray)
F0 = IsInArray2("F t-1", WBArray)
A0 = IsInArray2("Act-1", WBArray)
S = IsInArray2("S", WBArray)
'loop to match information in two arrays
For lRow = 2 To UBound(WBArray)
If IsInArray((WBArray(lRow, 1)), IS3) <> -1 Then
t = IsInArray((WBArray(lRow, 1)), IS3)
If C <> -1 Then w.Sheets("C").Cells(t, i + 3) = WBArray(lRow, C) Else: w.Sheets("C").Cells(t, i + 3) = "--"
If M <> -1 Then w.Sheets("M").Cells(t, i + 3) = WBArray(lRow, M) Else: w.Sheets("M").Cells(t, i + 3) = "--"
If W0 <> -1 Then w.Sheets("W t-1").Cells(t, i + 3) = WBArray(lRow, W0) Else: w.Sheets("W t-1").Cells(t, i + 3) = "--"
If P <> -1 Then w.Sheets("P").Cells(t, i + 3) = WBArray(lRow, P) Else: w.Sheets("P").Cells(t, i + 3) = "--"
If A <> -1 Then w.Sheets("A").Cells(t, i + 3) = WBArray(lRow, A) Else: w.Sheets("A").Cells(t, i + 3) = "--"
If PC <> -1 Then w.Sheets("PC").Cells(t, i + 3) = WBArray(lRow, PC) Else: w.Sheets("PC").Cells(t, i + 3) = "--"
If AM <> -1 Then w.Sheets("AM").Cells(t, i + 3) = WBArray(lRow, AM) Else: w.Sheets("AM").Cells(t, i + 3) = "--"
If AM0 <> -1 Then w.Sheets("AM t-1").Cells(t, i + 3) = WBArray(lRow, AM0) Else: w.Sheets("AM t-1").Cells(t, i + 3) = "--"
If P0 <> -1 Then w.Sheets("P t-1").Cells(t, i + 3) = WBArray(lRow, P0) Else: w.Sheets("P t-1").Cells(t, i + 3) = "--"
If F <> -1 Then w.Sheets("F").Cells(t, i + 3) = WBArray(lRow, F) Else: w.Sheets("F").Cells(t, i + 3) = "--"
If F0 <> -1 Then w.Sheets("F t-1").Cells(t, i + 3) = WBArray(lRow, F0) Else: w.Sheets("F t-1").Cells(t, i + 3) = "--"
If A0 <> -1 Then w.Sheets("A t-1").Cells(t, i + 3) = WBArray(lRow, A0) Else: w.Sheets("A t-1").Cells(t, i + 3) = "--"
If S<> -1 Then w.Sheets("S").Cells(t, i + 3) = WBArray(lRow, S) Else: w.Sheets("S").Cells(t, i + 3) = "--"
最后一件事是我创建了第二个IsInArray函数，其中下一步是位置，而不是位置+ 1