我一直在努力过滤三列并从三列中的每一列（合并）中取出所有内容并将其全部复制。因此，如果第一列返回1行，第2列返回2行，第3列返回1行。然后我想一次看到所有5行并复制它们。当过滤器中没有数据出现时，代码似乎不起作用。所以，我认为我需要if if语句，但由于某种原因它会给我一个错误＆＃34;运行时错误＆＃39; 1004＆＃39;：应用程序定义或对象定义的错误＆＃34 ;在.AutoFilter字段：= 11，Criteria1：= RGB（192,0,0），运算符：= xlFilterFontColor
非常感谢您提供任何帮助！我一整天都在努力尝试使用代码修复此错误。这是代码。
Sub FilterDifferences()
'Filtering by differences
Dim ws As Worksheet
Dim rng As Range
Dim rngK As Range
Dim rngL As Range
Dim rngM As Range
Dim Lrow As Long
Set ws = Sheets("Sheet1")
With ws
'~~> Get last row of Col M
Lrow = .Range("M" & .Rows.Count).End(xlUp).Row
'~~> Identify the range
Set rng = .Range("A1:M" & Lrow)
.AutoFilterMode = False
'~~> Identify the range in Col K Which has red font
With rng
.AutoFilter Field:=11, Criteria1:=RGB(192, 0, 0), Operator:=xlFilterFontColor
Set rngK = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
End With
.AutoFilterMode = False
'~~> Identify the range in Col L Which has red font
With rng
.AutoFilter Field:=12, Criteria1:=RGB(192, 0, 0), Operator:=xlFilterFontColor
Set rngL = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
End With
.AutoFilterMode = False
'~~> Identify the range in Col M Which has red font
With rng
.AutoFilter Field:=13, Criteria1:=RGB(192, 0, 0), Operator:=xlFilterFontColor
Set rngM = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
End With
ActiveSheet.AutoFilterMode = False
'~~> Hide All except the Header row
rng.Offset(1, 0).EntireRow.Hidden = True
'~~> Unhide the rows which have red font
Union(rngK, rngL, rngM).EntireRow.Hidden = False
End With
'Copying differences and putting them into a file
ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
End Sub
答案 0 :(得分：0)
不确定为什么会出现错误，因为您的代码在Excel 2007中完美运行，即使整个表格中没有红色字体单元格也是如此。我收到错误的唯一一次是表中根本没有数据。
也就是说，以下是陷阱和忽略错误的方法：
With rng
.AutoFilter Field:=11, Criteria1:=RGB(192, 0, 0), Operator:=xlFilterFontColor
On Error Resume Next
Set rngK = .Offset(1, 0).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rngK Is Nothing Then
MsgBox "Error filtering Col K"
End If
End With
您可以通过检查范围是否为Nothing来检查是否发生了错误。
修改
我能想到您遇到错误的唯一原因是您的工作簿损坏或Excel损坏。
您可以尝试创建新工作簿并将VBA代码和表数据复制/粘贴到其中，看看是否能解决问题。
对于Excel本身的问题，请尝试以下操作：
请注意，上述每个步骤都可能无法修复有问题的工作簿，但新创建的工作簿可能会有效。
关于您的新工作代码（不包括使用With ws和With rng），如果您正确包装 全部三个.SpecialCells...行的，当您到达{{1}时，无法任何范围都可能是Nothing }。
我还提供了三个代码示例供您试用。所有这三个在我的Excel版本中都正常工作，即使表格中没有任何数据也
。第一个是原始代码，其中包含更好的＆＃34;最后一行＆＃34;算法，三列检查汇总成一个循环，并消除所有不必要的变量：
Union第二个是你的新工作代码（以及我理解的）只有更好的＆＃34;最后一行＆＃34;算法补充：
Sub FilterDifferences1()
'Filtering by differences
Dim rng As Range
Dim rngUnion As Range
Dim varColNum As Variant
Dim Lrow As Long
With Sheets("Sheet1")
'~~> Get last row of Col M (Need to use Match() as .End(xlUp).Row only finds the last visible row
Set rng = .Range("M:M")
With WorksheetFunction
On Error Resume Next
Lrow = 1
Lrow = .Max(Lrow, .Match(1E+306, rng, 1))
Lrow = .Max(Lrow, .Match("*", rng, -1))
On Error GoTo 0
End With
'~~> Identify the range and use it
With .Range("A1:M" & Lrow)
.EntireRow.Hidden = False
'~~> Build up range of every Col Which has red font
Set rngUnion = .Rows(1)
For Each varColNum In Array(11, 12, 13)
'~~> Identify the range in current Col Which has red font
.AutoFilter Field:=varColNum, Criteria1:=RGB(192, 0, 0), Operator:=xlFilterFontColor
Set rngUnion = Union(rngUnion, .Offset(1, 0).SpecialCells(xlCellTypeVisible))
.AutoFilter ' Turns AutoFilter off and shows all rows
Next varColNum
'~~> Hide All except the Header row
.Offset(1, 0).EntireRow.Hidden = True
'~~> Unhide the rows which have red font
rngUnion.EntireRow.Hidden = False
End With
'Copying differences and putting them into a file
.UsedRange.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
End With
End Sub
最后一个是你的新工作代码，有更好的＆＃34;最后一行＆＃34;算法，三列检查汇总成一个循环，并消除所有不必要的变量：
Sub FilterDifferences2()
'Filtering by differences
Dim ws As Worksheet
Dim rng As Range
Dim rngK As Range
Dim rngL As Range
Dim rngM As Range
Dim Lrow As Long
Set ws = Sheets("Sheet1")
'~~> Get last row of Col M (Need to use Match() as .End(xlUp).Row only finds the last visible row
Set rng = Range("M:M")
With WorksheetFunction
On Error Resume Next
Lrow = 1
Lrow = .Max(Lrow, .Match(1E+306, rng, 1))
Lrow = .Max(Lrow, .Match("*", rng, -1))
On Error GoTo 0
End With
'~~> Identify the range and use it
Range("A1:M" & Lrow).EntireRow.Hidden = False
'~~> Identify the range in Col K Which has red font
Range("A1:M" & Lrow).AutoFilter Field:=11, Criteria1:=RGB(192, 0, 0), Operator:=xlFilterFontColor
' On Error Resume Next
Set rngK = ActiveSheet.AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible)
' On Error GoTo 0
If rngK Is Nothing Then
Set rngK = Range("A1:M1")
End If
Range("A1:M" & Lrow).AutoFilter ' Turns AutoFilter off and shows all rows
'~~> Identify the range in Col L Which has red font
Range("A1:M" & Lrow).AutoFilter Field:=12, Criteria1:=RGB(192, 0, 0), Operator:=xlFilterFontColor
On Error Resume Next
Set rngL = ActiveSheet.AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rngL Is Nothing Then
Set rngL = Range("A1:M1")
End If
Range("A1:M" & Lrow).AutoFilter ' Turns AutoFilter off and shows all rows
'~~> Identify the range in Col M Which has red font
Range("A1:M" & Lrow).AutoFilter Field:=13, Criteria1:=RGB(192, 0, 0), Operator:=xlFilterFontColor
On Error Resume Next
Set rngM = ActiveSheet.AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rngM Is Nothing Then
Set rngM = Range("A1:M1")
End If
Range("A1:M" & Lrow).AutoFilter ' Turns AutoFilter off and shows all rows
'~~> Hide All except the Header row
Range("A1:M" & Lrow).Offset(1, 0).EntireRow.Hidden = True
'~~> Unhide the rows which have red font
On Error Resume Next
Union(rngK, rngL, rngM).EntireRow.Hidden = False
On Error GoTo 0
'Copying differences and putting them into a file
ws.UsedRange.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
End Sub