Question

我有以下代码，在一些不相关的进程过滤A列后，返回包含＆＃34; N＆＃34;的所有单元格。字母（然后将结果复制到另一个要处理的工作表，然后再从该工作表复制到另一个工作表）。

代码对3个标准做同样的事情。（此段仅适用于＆＃34; N＆＃34;标准）。

问题： 当没有包含＆＃34; N＆＃34;它给出了一个错误，即没有找到任何单元格并停止整个过程。

我需要它来对已应用的所有过滤器进行反过滤，并继续使用下一个段来过滤包含＆＃34; CM＆＃34;的单元格。等等。

尝试计算可见细胞，并且在错误情况下使用＆＃34;＆＃34;但我甚至无法接近使其发挥作用。只返回相同的错误。

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Application.StatusBar = "Se proceseaza informatiile introduse. Va rog asteptati! Durata estimata: 1 minut."

' it clears the sheet were it will paste the processed information
Sheets("EXTRAGERE NR").Range("A2:A2000").ClearContents

Dim Src As Worksheet
Dim tgt As Worksheet
Dim filterRange As Range
Dim copyRange As Range
Dim lastRow As Long

Set Src = ThisWorkbook.Sheets("LISTA CTR")
Set tgt = ThisWorkbook.Sheets("EXTRAGERE NR")
Set NP = ThisWorkbook.Sheets("NEVOI PERSONALE")
Set RR = ThisWorkbook.Sheets("RATE")
Set CM = ThisWorkbook.Sheets("CARDURI")
Set rez = ThisWorkbook.Sheets("REZULTAT")

' SEGMENTUL NEVOI PERSONALE
Sheets("EXTRAGERE NR").Range("A2:A2000").ClearContents

' turn off any autofilters that are already set
Src.AutoFilterMode = False

' find the last row with data in column A
lastRow = Src.Range("A" & Src.Rows.Count).End(xlUp).Row

'remove duplicates
Sheets("LISTA CTR").Range("A3:A" & lastRow).RemoveDuplicates Columns:=Array(1), Header:=xlYes

' reformat specified ranges by pasting format only from a chosen cell
Sheets("LISTA CTR").Range("E1048575").Copy
Sheets("LISTA CTR").Range("A3:A" & lastRow).PasteSpecial xlPasteFormats             

' the range that we are auto-filtering (all columns)
Set filterRange = Src.Range("A2:D" & lastRow)

' the range we want to copy (only columns we want to copy)
' in this case we are copying country from column A
' we set the range to start in row 2 to prevent copying the header
Set copyRange = Src.Range("A3:A" & lastRow)

' filter range based on column B
filterRange.AutoFilter Field:=1, Criteria1:="=*N*"

' copy the visible cells to our target range
' note that you can easily find the last populated row on this sheet
' if you don't want to over-write your previous results

＆＃39;问题就在这里，当没有＆＃34; N＆＃34;过滤和返回没有找到任何细胞的错误的元素

copyRange.SpecialCells(xlCellTypeVisible).Cells.Interior.ColorIndex = 6   'coloreaza nevoile personale in galben
copyRange.SpecialCells(xlCellTypeVisible).Copy tgt.Range("A2")

If (Sheets("LISTA CTR").AutoFilterMode And Sheets("LISTA CTR").FilterMode) Or Sheets("LISTA CTR").FilterMode Then
    Sheets("LISTA CTR").ShowAllData
End If            

' SortareAlaZ NUMERE EXTRASE - NEVOI PERSONALE            
ActiveWorkbook.Worksheets("EXTRAGERE NR").AutoFilter.Sort.SortFields.Clear              
ActiveWorkbook.Worksheets("EXTRAGERE NR").AutoFilter.Sort.SortFields. _
                Add Key:=Range("C2"), SortOn:=xlSortOnValues, Order:=xlAscending, _
                DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("EXTRAGERE NR").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

'copiere numere extrase in sheetul pentru generarea cailor - NEVOI PERSONALE
tgt.Range("C2:C" & lastRow).Copy
With NP.Range("F2")
    .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
                         SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
End With

Set copyRange = tgt.Range("A2:A" & lastRow)
copyRange.Copy NP.Range("H2")

Answer 1

您可以使用Application.CountIf功能查找filterRange中的匹配项数。

尝试以下代码：

If Application.CountIf(filterRange, "*N*") < 1 Then '<-- no matches
    MsgBox "No values with *N* in Range", vbCritical
    Exit Sub
Else
    ' filter range based on column B
    filterRange.AutoFilter Field:=1, Criteria1:="=*N*"

    ' the rest of your code goes here
End If

要查找整个B列中是否有"*N"，请使用：

If Application.CountIf(Range("B:B"), "*N*") < 1 Then '<-- no matches

如果过滤范围为空，则重置过滤器并跳至

1 个答案: