我有2个工作表，我正在尝试将它们合并到一个工作表中，并将所有字段合并到一个新工作表中。我在网上找到了一些代码并对其进行了一些修改以包含我想要的列。出于某种原因，我在尝试运行宏时看到语法错误。 Excel自动转到显示“Function MapColumns（fileName As String）As Object”的行并突出显示它。我不知道这是什么错。我希望有人可以对这个问题有所了解并告诉我我做错了什么。
Sub MergeExcelFiles()
Dim firstRowHeaders As Boolean
Dim columnMap As Collection
Dim fso As Object
Dim dir As Object
Dim filePath As Variant
Dim fileName As String
Dim file As String
Dim wb As Workbook
Dim s As Sheet1
Dim thisSheet As Sheet1
Dim dataRange As Range
Dim insertAtRowNum As Integer
Dim outColName As String
Dim colName As String
Dim fromRange As String
Dim fromRangeToCopy As Range
Dim toRange As String
On Error GoTo ErrMsg
Application.ScreenUpdating = False
firstRowHeaders = True 'Change from True to False if there are no headers in the first row
Set fso = CreateObject("Scripting.FileSystemObject")
'PLEASE NOTE: Change <> to the path to the folder containing your Excel files to merge
Set dir = fso.Getfolder("C:\User\xxxxxxxDesktop\MergeExcel")
Set thisSheet = ThisWorkbook.ActiveSheet
'Insert rows after the last used cell in the master spreadsheet
If Application.Version < "12.0" Then 'Excel 2007 introduced more rows
insertAtRowNum = thisSheet.Range("A65536").End(xlUp).Row
Else
insertAtRowNum = thisSheet.Range("A1048576").End(xlUp).Row
End If
'Only offset by 1 if there are current rows with data in them
If thisSheet.UsedRange.Rows.Count > 1 Or Application.CountA(thisSheet.Rows(1)) Then
insertAtRowNum = insertAtRowNum + 1
End If
For Each filePath In dir.Files
fileName = Right(filePath, Len(filePath) - InStrRev(filePath, Application.PathSeparator, , 1))
'Get the map of columns for this file
Set columnMap = MapColumns(fileName)
'Open the spreadsheet in ReadOnly mode
Set wb = Application.Workbooks.Open(filePath, ReadOnly:=True)
For Each sourceSheet In wb.Sheets
'Get the used range (i.e. cells with data) from the opened spreadsheet
If firstRowHeaders Then 'Don't include headers
Dim mr As Integer
mr = sourceSheet.UsedRange.Rows.Count
Set dataRange = sourceSheet.UsedRange.Offset(1, 0).Resize(mr - 1)
Else
Set dataRange = sourceSheet.UsedRange
End If
For Each col In dataRange.Columns
'Get corresponding output column. Empty string means no mapping
colName = GetColName(col.Column)
outColName = GetOutputColumn(columnMap, colName)
If outColName <> "" Then
fromRange = colName & 1 & ":" & colName & dataRange.Rows.Count
Set fromRangeToCopy = dataRange.Range(fromRange)
fromRangeToCopy.Copy
toRange = outColName & insertAtRowNum & ":" & outColName & (insertAtRowNum + fromRangeToCopy.Rows.Count - 1)
thisSheet.Range(toRange).PasteSpecial
End If
Next col
insertAtRowNum = insertAtRowNum + dataRange.Rows.Count
Next sourceSheet
Application.CutCopyMode = False
Next filePath
ThisWorkbook.Save
Set wb = Nothing
#If Mac Then
'Do nothing. Closing workbooks fails on Mac for some reason
#Else
'Close the workbooks except this one
For Each filePath In dir.Files
file = Right(filePath, Len(filePath) - InStrRev(filePath, Application.PathSeparator, , 1))
Workbooks(file).Close SaveChanges:=False
Next filePath
#End If
Application.ScreenUpdating = True
ErrMsg:
If Err.Number <> 0 Then
MsgBox "There was an error. Please try again. [" & Err.Description & "]"
End If
End Sub
Function MapColumns(fileName As String) As Object
Dim colMap As New Collection
Select Case fileName
Dim colMap As New Collection
Select Case fileName
Case "Original.xlsx"
colMap.Add Key:='A', Item:='A'
colMap.Add Key:='B' Item:='B'
colMap.Add Key:='C', Item:='C'
colMap.Add Key:='D', Item:='D'
colMap.Add Key:='E', Item:='E'
colMap.Add Key:='G', Item:='G'
colMap.Add Key:='H', Item:='H'
colMap.Add Key:='I', Item:='I'
colMap.Add Key:='J', Item:='J'
colMap.Add Key:='K', Item:='K'
colMap.Add Key:='L', Item:='L'
colMap.Add Key:='M', Item:='M'
colMap.Add Key:='N', Item:='N'
colMap.Add Key:='O', Item:='O'
colMap.Add Key:='P', Item:='P'
Case "Dialed.xlsx"
colMap.Add Key:='B', Item:='Q'
colMap.Add Key:='C', Item:='S'
colMap.Add Key:='D', Item:='T'
colMap.Add Key:='E', Item:='U'
colMap.Add Key:='H', Item:='V'
colMap.Add Key:='N', Item:='B'
colMap.Add Key:='P', Item:='C'
colMap.Add Key:='Q', Item:='D'
colMap.Add Key:='R', Item:='E'
colMap.Add Key:='T', Item:='F'
colMap.Add Key:='U', Item:='G'
colMap.Add Key:='W', Item:='H'
colMap.Add Key:='AE', Item:='W'
colMap.Add Key:='AD', Item:='X'
End Select
Set MapColumns = colMap
End Function
Function GetOutputColumn(columnMap As Collection, col As String) As String
Dim outCol As String
outCol = ""
If columnMap.Count > 0 Then
outCol = columnMap.Item(col)
End If
GetOutputColumn = outCol
End Function
'From: http://www.mrexcel.com/forum/excel-questions/16444-getting-column-name-given-column-number.html
Function GetColName(ColumnNumber)
FuncRange = Cells(1, ColumnNumber).AddressLocal(False, False) 'Creates Range (defaults Row to 1) and retuns Range in xlA1 format
FuncColLength = Len(FuncRange) 'finds length of range reference
GetColName = Left(FuncRange, FuncColLength - 1) 'row always "1" therefore take 1 away from string length and you are left with column ref
End Function
Original.xlsx列 A-Home电话 B-名字 C-姓氏 d-地址 E-地址2 F-市 G状态 H-Zip代码 I-县 J出生月 K出生年份 L-Primary DOB M-小学年龄 氮源 O形垂直
Dialed.xlsx Columns
A-lead_id
B-entry_date
C-modify_date
D-status
E-user
F-vendor_lead_code
G-source_id
H-list_id
I-gmt_offset_now
J-called_since_last_reset
K-phone_code
L-phone_number
M-title
N-first_name
O-middle_initial
P-last_name
Q-address1
R-address2
S-address3
T-city
U-state
V-province
W-postal_code
X-country_code
Y-gender
Z-date_of_birth
AA-alt_phone
AB-email
AC-security_phrase
AD-comments
AE-called_count
AF-last_local_call_time
AG-rank
AH-owner
AI-month_birth
AJ-month_year
Original有我通常使用的主要字段，而Dialed有一些相同的字段和一些我试图添加到我的最终电子表格中的其他字段。
任何帮助将不胜感激。