excel - 在 Excel 中合并文件时出现空行问题

Question

我最近开始工作，有时我们被赋予从许多 excel 文件中提取数据的任务，但是，它们总是以相同的方式格式化数据，从 A5:I5 及以下，文件有不同的数量包含数据的行数

它是一个宏，可以打开文件夹中的每个 Excel 文件，从 A5:I5 及以下抓取数据，并将其粘贴到单独的文档中。

问题是我要合并的一些文件以不同的方式格式化，我的代码无法正确处理它们。有些文件底部只有一行，这导致需要TEXTbtm删除空行部分

但是，某些文件的数据中有空行，并且代码的结构方式目前我错过了第一个空行下方的所有数据。

/进程文件：

Sub ProcessFiles()
Dim Filename, Pathname As String
Dim wb As Workbook

'Sets the folder containing files
Pathname = ActiveWorkbook.Path & "\Lists\"
Filename = Dir(Pathname & "*.xls")

'This part loops through all excelfiles in Lists and executes DoWork
Application.ScreenUpdating = False
Do While Filename <> ""
    Set wb = Workbooks.Open(Pathname & Filename)
    DoWork wb


    wb.Close SaveChanges:=True
    Filename = Dir()
Loop

'After importing the data, this clears up any empty rows, from 1-5000
'This part is quite slow, but it works
Workbooks.Open Filename:="C:\Users\Computer\Desktop\NAME\Folder\Main.xlsx"
Application.ScreenUpdating = True
Range("A1:I5000").Select
Dim iCounter As Long
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
For iCounter = Selection.Rows.Count To 1 Step -1
If WorksheetFunction.CountA(Selection.Rows(iCounter)) = 0 Then
Selection.Rows(iCounter).EntireRow.Delete
End If
Next iCounter
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With



'This part removes the rows with only TEXTbtm written in the first cell
'This happens as some files have only one row, and the xlDown in DoWork 
'then grabs blank rows at the bottom, including these.
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1:I1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$I$3").AutoFilter Field:=1, Criteria1:="TEXTbtm"
Range("A1:I1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Application.DisplayAlerts = False
Selection.Delete Shift:=xlUp
Application.DisplayAlerts = True
Range("A1:A1").Select

End Sub

/做工作：

Sub DoWork(wb As Workbook)
With wb

'selects A5:I5 and marks the underlying rows as well
 Range("A5:I5").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

'Pastes the data into a file called Main, and selects the first empty row
Workbooks.Open Filename:="C:\Users\Computer\Desktop\NAME\Makro\Main.xlsx"
ActiveSheet.Paste
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select

'clears what is copied, and closes the file
Application.CutCopyMode = False
ActiveWorkbook.Close True



End With
End Sub

标签： excelvba

Answer 1

而不是Range(Selection, Selection.End(xlDown)).Select您可以使用以下内容：

Dim lRow As Long
lRow = Cells.Find("*", Range("A1"), xlFormulas, xlPart, xlByRows, xlPrevious).Row 

lRow = 最后一行的编号

Range(Cells(1,1), Cells(lRow, 9)).Select

编辑：缺少括号