如何用VBA导入Excel数据并排除Remaining Months列为0的行？

方案1：复制完成后在目标表中清理0值行（改动最小） #

不用动原有的数据读取逻辑，在数据复制到目标ListObject之后，加一段筛选删除的代码即可。假设你的目标ListObject叫tblTarget，对应工作表是"导入目标表"，直接添加这段代码：

Dim targetLo As ListObject
Set targetLo = ThisWorkbook.Worksheets("导入目标表").ListObjects("tblTarget")

' 清除原有筛选，避免干扰
targetLo.AutoFilter.ShowAllData

' 对"Remaining Months of Depreciation"列筛选0值
With targetLo.ListColumns("Remaining Months of Depreciation")
    .Range.AutoFilter Field:=.Index, Criteria1:="0"
End With

' 删除筛选出来的可见行（跳过表头）
On Error Resume Next ' 防止没找到0值行时报错
targetLo.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
On Error GoTo 0

' 最后清掉筛选
targetLo.AutoFilter.ShowAllData

方案2：读取源数据时直接跳过0值行（更高效） #

如果不想后期删除行，也可以在读取源数据的时候就过滤掉第四列为0的行。先保留你原来的表头定位逻辑，再替换复制逻辑：

1. 先获取源表中目标列的列号（复用你的表头匹配逻辑） #

Dim sourceWs As Worksheet
Dim colDeprMonths As Long, col1 As Long, col2 As Long, col3 As Long
Set sourceWs = Workbooks("源文件.xlsx").Worksheets("源工作表")

' 匹配各目标列的列号（复用你原有的表头查找逻辑）
col1 = sourceWs.Rows(1).Find("Asset Description", LookIn:=xlValues, LookAt:=xlWhole).Column
' 这里补充你另外两列的表头匹配代码，比如col2、col3
colDeprMonths = sourceWs.Rows(1).Find("Remaining Months of Depreciation", LookIn:=xlValues, LookAt:=xlWhole).Column

2. 循环遍历源数据，只复制非0行 #

Dim lastRow As Long, i As Long
Dim newListRow As ListRow
lastRow = sourceWs.Cells(sourceWs.Rows.Count, colDeprMonths).End(xlUp).Row

' 遍历源数据行，只复制非0的行
For i = 2 To lastRow
    If sourceWs.Cells(i, colDeprMonths).Value <> 0 Then
        Set newListRow = targetLo.ListRows.Add
        ' 复制当前行的4列数据到目标ListObject
        newListRow.Range(1).Value = sourceWs.Cells(i, col1).Value
        newListRow.Range(2).Value = sourceWs.Cells(i, col2).Value
        newListRow.Range(3).Value = sourceWs.Cells(i, col3).Value
        newListRow.Range(4).Value = sourceWs.Cells(i, colDeprMonths).Value
    End If
Next i

如果数据量很大，用数组处理效率更高：

Dim sourceArr As Variant, filteredArr As Variant
Dim r As Long, c As Long, validRowCount As Long

' 把源数据读入数组（替换为你实际的源数据范围）
sourceArr = sourceWs.Range(sourceWs.Cells(2, col1), sourceWs.Cells(lastRow, colDeprMonths)).Value

' 先统计有效行数量
validRowCount = 0
For r = 1 To UBound(sourceArr)
    If sourceArr(r, 4) <> 0 Then validRowCount = validRowCount + 1
Next r

' 生成过滤后的数组
ReDim filteredArr(1 To validRowCount, 1 To 4)
validRowCount = 0
For r = 1 To UBound(sourceArr)
    If sourceArr(r, 4) <> 0 Then
        validRowCount = validRowCount + 1
        For c = 1 To 4
            filteredArr(validRowCount, c) = sourceArr(r, c)
        Next c
    End If
Next r

' 写入目标ListObject
If validRowCount > 0 Then
    targetLo.ListRows.Add.Range.Resize(validRowCount).Value = filteredArr
End If

注意事项 #

• 替换代码中的工作表名、ListObject名称为你实际使用的名称。
• 方案1适合小数据量，改起来最快；方案2适合大数据量，避免删除行带来的性能损耗。

内容的提问来源于stack exchange，提问作者jmt78