Vba 如何插入文件名
下面的代码允许我浏览多个不同的excel文件,并将它们粘贴到一张单独的表格中。excel文件的列名相同,但数据不同,工作正常,我的问题是粘贴文件时需要它,它必须为粘贴的每个文件写入该文件的名称。我的excel文件名为Familycar,其他excel文件名为smartcar 示例 eg1卡纳姆、燃料、颜色 宝马,汽油,红色 福特、柴油、绿色 马自达,汽油,灰色 eg2卡纳姆,燃料,颜色 奥斯汀,汽油,蓝色 大众,柴油,白色 奥迪,汽油,黑色 结果 卡纳姆、燃料、颜色、文件名 宝马、汽油、红色、Familycar 福特、柴油、绿色、家庭汽车 马自达、汽油、灰色、Familycar 奥斯汀,汽油,蓝色,斯马特卡 大众、柴油、白色、智能车 奥迪,汽油,黑色,智能车Vba 如何插入文件名,vba,excel,Vba,Excel,下面的代码允许我浏览多个不同的excel文件,并将它们粘贴到一张单独的表格中。excel文件的列名相同,但数据不同,工作正常,我的问题是粘贴文件时需要它,它必须为粘贴的每个文件写入该文件的名称。我的excel文件名为Familycar,其他excel文件名为smartcar 示例 eg1卡纳姆、燃料、颜色 宝马,汽油,红色 福特、柴油、绿色 马自达,汽油,灰色 eg2卡纳姆,燃料,颜色 奥斯汀,汽油,蓝色 大众,柴油,白色 奥迪,汽油,黑色 结果 卡纳姆、燃料、颜色、文件名 宝马、汽油、红色、F
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
添加到代码中
' 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
添加到代码中
' 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
下面是经过重构以包含此需求的代码
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
下面是经过重构以包含此需求的代码
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
感谢它的工作…但它不会在文件之间为文件名留下空格…感谢它的工作…但它不会在文件之间为文件名留下空格。。。