0

以下代码允许我浏览多个不同的 excel 文件并将它们粘贴到彼此下方的单个工作表中。excel 文件具有相同的列名但其中包含不同的数据并且工作正常，我的问题是我需要它时粘贴一个文件，它必须为它粘贴的每个文件写下该文件的名称。我的excel文件的名称称为Familycar，其他excel的文件名称为smartcar

例子

eg1车名、燃料、颜色

宝马，汽油，红色

福特，柴油，绿色

马自达,汽油,灰色

eg2车名、燃料、颜色

奥斯汀，汽油，蓝色

大众,柴油,白色

奥迪,汽油,黑色

结果

车名、燃油、颜色、文件名

宝马,汽油,红色,家用车

福特,柴油,绿色,家用车

马自达,汽油,灰色,家庭车

奥斯汀，汽油，蓝色，智能汽车

大众，柴油，白色，智能汽车

奥迪,汽油,黑色,智能车

   Sub Button5_Click()
 Dim fileStr As Variant
 Dim wbk1 As Workbook, wbk2 As Workbook
 Dim ws1 As Worksheet

 fileStr = Application.GetOpenFilename(FileFilter:="microsoft excel files (*.xlsx), *.xlsx", Title:="Get File", MultiSelect:=True)
 Set wbk1 = ActiveWorkbook
 Set ws1 = wbk1.Sheets("Sheet3")

 'handling first file seperately
 MsgBox fileStr(1), , GetFileName(CStr(fileStr(1)))
 Set wbk2 = Workbooks.Open(fileStr(1))
 wbk2.Sheets(1).UsedRange.Copy ws1.Cells(ws1.Range("A" & Rows.Count).End(xlUp).Row + 2, 1)

 wbk2.Close

 For i = 2 To UBound(fileStr)
 MsgBox fileStr(i), , GetFileName(CStr(fileStr(i)))

 Set wbk2 = Workbooks.Open(fileStr(i))

 wbk2.Sheets(1).UsedRange.Offset(1, 0).Copy ws1.Cells(ws1.Range("A" & Rows.Count).End(xlUp).Row + 2, 1)


 wbk2.Close
 Next i
4

2 回答 2

3

这是您的代码重构以包含此要求

Sub Button5_Click()
    Dim fileStr As Variant
    Dim wbk1 As Workbook, wbk2 As Workbook
    Dim ws1 As Worksheet
    Dim rngSource As Range
    Dim rngDest As Range
    Dim rwOffset As Long
    Dim sFileName As String

    Dim i As Long

    fileStr = Application.GetOpenFilename(FileFilter:="microsoft excel files (*.xlsx), *.xlsx", Title:="Get File", MultiSelect:=True)
    Set wbk1 = ActiveWorkbook
    Set ws1 = wbk1.Sheets("Sheet3")

    For i = 1 To UBound(fileStr)
        MsgBox fileStr(i), , GetFileName(CStr(fileStr(i)))

        ' Used to change copy range for first file, without repeating code
        rwOffset = IIf(i = 1, 0, 1)
        Set wbk2 = Workbooks.Open(fileStr(i))

        ' File Name without extension
        sFileName = Left$(wbk2.Name, InStrRev(fileStr(i), ".") - 1)  

        Set rngSource = wbk2.Sheets(1).UsedRange.Offset(rwOffset, 0)
        Set rngDest = ws1.Cells(ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row + 2, 1)

        rngSource.Copy rngDest

        ' Add filename next to pasted data
        rngDest.Offset(0, rngSource.Columns.Count).Resize(rngSource.Rows.Count, 1) = sFileName
        wbk2.Close
    Next i

End Sub
于 2012-10-17T07:59:42.747 回答
1

添加到您的代码

' ws1 is the result/output worksheet
' wbk2 is the input workbook I assume
Dim fromRow As Long
Dim toRow As Long
Dim colNum As Long 'please defind the column Number to output the workbook's name
' In your example, it would be 4
colNum = 4
fromRow = ws1.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
wbk2.Sheets(1).UsedRange.Offset(1, 0).Copy ws1.Cells(ws1.Range("A" & Rows.Count).End(xlUp).Row + 2, 1)
toRow = ws1.Cells(ws.Rows.Count, 1).End(xlUp).Row
ws1.Range(ws1.Cells(fromRow, colNum), ws1.Cells(toRow, colNum)).Value = wbk2.Name
于 2012-10-17T07:53:23.693 回答