Question

所以我正在尝试创建一个宏，它将自动过滤一系列数据（在E列中），用于从N列开始的预定义标题。因此，自动过滤器会在列e中为第n列中的标题过滤数据，它然后将该数据复制并粘贴到列n中，然后循环并对列o执行相同操作，依此类推。我遇到的问题是，如果过滤器运行，并且自动过滤器没有匹配则会产生错误。奇怪的是，我使用了如果错误转到，并且对于一个空白列它完美地工作，但是如果有两个空白列，那么它第二次失败。我已经发布了以下代码。有没有人有任何建议？

Sub Siglum_Sorter()

Sheets("Operator Database").Select


Dim rRng1 As Range
Dim rRng2 As Range
Dim fCol As Long
fCol = 13

Set rRng1 = Range("E:E")
Set rRng2 = Range("G2:G100")
Do

On Error GoTo SkipToHere

fCol = fCol + 1
rCrit = Cells(1, fCol)

MsgBox "cells   " & fCol & "    " & rCrit

With rRng1
.AutoFilter field:=1, Criteria1:=rCrit, Operator:=xlOr

rRng2.SpecialCells(xlCellTypeVisible).Copy 'or do something else
End With

Cells(2, fCol).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

SkipToHere:

Loop Until IsEmpty(Cells(1, fCol))

End Sub

Answer 1

Dim rngF As Range

With rRng1.AutoFilter field:=1, Criteria1:=rCrit, Operator:=xlOr

Set rngF = Nothing
On Error Resume Next 'ignore any error if no visible cells
Set rngF = rRng2.SpecialCells(xlCellTypeVisible)
On Error Goto 0

If Not rngF Is Nothing Then
    'do something with rngF
Else
    'no visible cells...
End If

Answer 2

我只想在过滤器后添加一个检查，看看最后一个可见行是否是数据头。如果是这样，请不要复制数据

Dim lrow_data as long
lrow_data = ThisWorkbook.Sheets("Sheet1").Cells(Cells.Rows.Count,1).End(xlUp) 'or change it to your needed sheet

If lrow_data = 1 Then
    'Do Nothing, last row is the headers
    Else
    rRng2.SpecialCells(xlCellTypeVisible).Copy
End If

自动过滤器不返回任何数据

2 个答案: