如何根据使用VBA的行数增加单元格
假设我有两个文件：
FILE1.xls FILE2.xls FILE1.xls包含：
AAA BBB
FILE2.xls包含：
XXX YYY ZZZ
我目前有这样的代码：
Sub LoopAllExcelFilesInFolder() 'PURPOSE: To loop through all Excel files in a user specified folder and perform a set task on them 'SOURCE: www.TheSpreadsheetGuru.com Dim wb As Workbook Dim myPath As String Dim myFile As String Dim myExtension As String Dim FldrPicker As FileDialog Dim FileName As String Dim FileName1 As String Dim bookList As Workbook Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object 'Optimize Macro Speed Application.ScreenUpdating = False Application.EnableEvents = False Application.Calculation = xlCalculationManual 'Retrieve Target Folder Path From User Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) With FldrPicker .Title = "Select A Target Folder" .AllowMultiSelect = False If .Show <> -1 Then GoTo NextCode myPath = .SelectedItems(1) & "\" End With 'In Case of Cancel NextCode: myPath = myPath If myPath = "" Then GoTo ResetSettings 'Target File Extension (must include wildcard "*") myExtension = "*.xls" 'Target Path with Ending Extention myFile = Dir(myPath & myExtension) 'Loop through each Excel file in folder Do While myFile <> "" 'Set variable equal to opened workbook Set wb = Workbooks.Open(FileName:=myPath & myFile) 'Change First Worksheet's Background Fill Blue FileName = wb.Name FileName1 = Replace(FileName, ".xls", "") Range("B1:B2").Value = FileName1 'Save and Close Workbook wb.Close SaveChanges:=True 'Get next file name myFile = Dir Loop 'Message Box when tasks are completed MsgBox "Task Complete!" Application.ScreenUpdating = False Set mergeObj = CreateObject("Scripting.FileSystemObject") 'change folder path of excel files here Set dirObj = mergeObj.Getfolder("C:\Users\guintop\Desktop\paul\MERGE") Set filesObj = dirObj.Files For Each everyObj In filesObj Set bookList = Workbooks.Open(everyObj) 'change "A2" with cell reference of start point for every files here 'for example "B3:IV" to merge all files start from columns B and rows 3 'If you're files using more than IV column, change it to the latest column 'Also change "A" column on "A65536" to the same column as start point Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy ThisWorkbook.Worksheets(1).Activate 'Do not change the following column. It's not the same column as above Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial Application.CutCopyMode = False bookList.Close Next ResetSettings: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub
如果我运行这个代码，它将会：
- 获取所选目录中存在的文件的文件名，
- 插入文件名称（不带扩展名）为每个文件指定的单元格
- 代码的最后一部分将把所有文件合并成一个excel文件。
并将有一个像这样的输出用于最终输出文件
AAA FILE1 BBB FILE1 XXX FILE2 YYY FILE2 ZZZ -> BLANK
正如你注意到的，ZZZ的最后一部分将是空白的，因为我在特定的单元格上分配了文件名。 如何调整此代码以自动填写单元格B1-B3？ 或者B1-B5如果我在单元格A中有5行数据？
find具有值的最后一行。
Dim ws As Excel.Worksheet Dim lastRow As Long Set ws = ActiveWorkbook.Sheets("Sheet1") lastRow = ws.Cells(ws.Rows.count, "A").End(xlUp).Row
然后使用该值而不是硬编码该行。
Range("B1:B" & lastRow).Value = FileName1