如何在没有1004错误的情况下过滤和填充可见单元格

Question

我试图使用指定的关键字筛选列A，然后使用"Sub RunThis“填充B列可见单元格中的一些文本，当我的关键字与任何行A不匹配时，error1004就会出现。

你能建议我解决这个问题吗？

非常感谢,

我的交叉贴纸http://www.excelforum.com/showthread.php?t=1085681&p=4088366 http://www.ozgrid.com/forum/showthread.php?t=195012

Public LastRow As Long 
Sub RunThis() 
    LastRow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row 
     'Suite1
     'Suite2
     'Suite3
     'Suite4
     'Suite5
    Suite6 
     'Suite7
     'Suite8
     'Suite9
     'Suite10
     'Suite11


End Sub 




 '==============================FIND===Suite6==================
Sub Suite6() 
    On Error Goto NEXT0 
     '============Search KeyWord 1 2
    ActiveSheet.Range("A:A").AutoFilter Field:=1, Criteria1:= _ 
    "=*S6R*", Operator:=xlOr, Criteria2:="=*Suite6/*" 
     ' Select target column to paste
    Range("D2:D" & LastRow).Select 
    Selection.SpecialCells(xlCellTypeVisible).Select 
     ' TargetText for this search
    Selection.FormulaR1C1 = "Suite-6" 
NEXT0: 
    On Error Goto NEXT2 
    ActiveSheet.Range("A:A").AutoFilter Field:=1, Criteria1:= _ 
    "=*Suite 6/*", Operator:=xlOr, Criteria2:="=*Suite_6/*" 
     ' Select target column to paste
    Range("D2:D" & LastRow).Select 
    Selection.SpecialCells(xlCellTypeVisible).Select 
     ' TargetText for this search
    Selection.FormulaR1C1 = "Suite-6" 
NEXT2: 
    On Error Goto NEXT3 
    ActiveSheet.Range("A:A").AutoFilter Field:=1, Criteria1:= _ 
    "=*Suite-6/*", Operator:=xlOr, Criteria2:="=*Suite6.*" 
     ' Select target column to paste
    Range("D2:D" & LastRow).Select 
    Selection.SpecialCells(xlCellTypeVisible).Select 
     ' TargetText for this search
    Selection.FormulaR1C1 = "Suite-6" 
NEXT3: 
    On Error Goto NEXT4 
    ActiveSheet.Range("A:A").AutoFilter Field:=1, Criteria1:= _ 
    "=*Suite 6.*", Operator:=xlOr, Criteria2:="=*Suite_6.*" 
     ' Select target column to paste
    Range("D2:D" & LastRow).Select 
    Selection.SpecialCells(xlCellTypeVisible).Select 
     ' TargetText for this search
    Selection.FormulaR1C1 = "Suite-6" 
NEXT4: 
    On Error Goto NEXT5 
    ActiveSheet.Range("A:A").AutoFilter Field:=1, Criteria1:= _ 
    "=*Suite-6.*", Operator:=xlOr, Criteria2:="=*Suite-6/*" 
     ' Select target column to paste
    Range("D2:D" & LastRow).Select 
    Selection.SpecialCells(xlCellTypeVisible).Select 
     ' TargetText for this search
    Selection.FormulaR1C1 = "Suite-6" 
NEXT5: 
End Sub 

Answer 1

这将解决您的根本问题，而不创建混乱的杂乱代码或留下过滤器。作为一项奖励，我认为它将有一个更低的运行时，和一些智慧，你可以让它循环在套件1-11。

Public LastRow As Long
Sub RunThis()
    LastRow = Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
     'Suite1
     'Suite2
     'Suite3
     'Suite4
     'Suite5
    Suite6
     'Suite7
     'Suite8
     'Suite9
     'Suite10
     'Suite11


End Sub




 '==============================FIND===Suite6==================
Private Sub Suite6()
Dim ArrayOfStrings() As String
'ArrayOfStrings = Array("*S6R*", "*Suite6/*", "*Suite 6/*", "*Suite_6/*", "*Suite-6/*", _
                    "*Suite6.*", "*Suite 6.*", "*Suite_6.*", "*Suite-6.*", "*Suite-6/*")
ReDim ArrayOfStrings(9)
ArrayOfStrings(0) = "*S6R*"
ArrayOfStrings(1) = "*Suite6/*"
ArrayOfStrings(2) = "*Suite_6/*"
ArrayOfStrings(3) = "*Suite-6/*"
ArrayOfStrings(4) = "*Suite6.*"
ArrayOfStrings(5) = "*Suite 6.*"
ArrayOfStrings(6) = "*Suite_6.*"
ArrayOfStrings(7) = "*Suite-6.*"
ArrayOfStrings(8) = "*Suite 6/*"
ArrayOfStrings(9) = "*Suite-6/*"
ColumnToCheck = "A" 'you were looking for values in the A column, weren't you?

For i = 1 To LastRow 'in each of the rows
    For j = LBound(ArrayOfStrings) To UBound(ArrayOfStrings) 'for each of the strings it could match
        If Cells(i, ColumnToCheck).Value2 Like ArrayOfStrings(j) Then Cells(i, ColumnToCheck).Value2 = "Suite-6" 'if there's a match, then replace it with a uniform "Suite-6"
    Next j
Next i
End Sub