过滤特定名称，如果不存在则跳到下一行代码答案

【问题标题】：filter for specific name, if not present skip to next line of code过滤特定名称，如果不存在则跳到下一行代码
【发布时间】：2014-07-24 19:53:05
【问题描述】：

我上周编写了这段代码，以按个人姓名过滤列复制活动单元格并将它们粘贴到保存为个人姓名的新工作表中。这很好，直到那个人的名字不再出现在数据集中。有没有办法列出名称，如果这些名称不存在，请转到下一个？此宏的大部分内容已记录。

 ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 7
ActiveSheet.Range("$A$1:$U$188").AutoFilter Field:=13, Criteria1:= _
    "Sauber Justin"
Range("M32").Select
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 15
Range("U1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Selection.Copy
Workbooks.Add
ActiveSheet.Paste
Range("M2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Sauber Justin"
With ActiveCell.Characters(Start:=1, Length:=10).Font
    .Name = "Arial"
    .FontStyle = "Regular"
    .Size = 11
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ThemeColor = xlThemeColorLight1
    .TintAndShade = 0
    .ThemeFont = xlThemeFontNone
End With
ActiveWorkbook.SaveAs Filename:="C:\Users\e450040\Desktop\Sauber Justin.xlsm", _
    FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Windows("ECROListExport.xlsm").Activate

【问题讨论】：

标签： excel skip

【解决方案1】：

你没有说名单的来源。但是，无论来源如何，您很可能都想研究循环和数组。下面是一些帮助您入门的代码。我刚刚在应该进行实际复制和粘贴的地方留下了评论，因为您似乎已经完成了该部分。

Sub Namer()

Dim NameArray(2) As String
NameArray(0) = "Sauber, Justin"
NameArray(1) = "Smith, George"
NameArray(2) = "Elwood, Marcus"

For i = 0 To UBound(NameArray)

'Check for Name
Dim HasName As Boolean
Dim TheCell As Range
For Each TheCell In Range("$A$1:$A$100")
If TheCell.Value = NameArray(i) Then
    HasName = True
End If
Next TheCell

'Filter and Copy
If HasName = True Then
ActiveSheet.Range("$A$1:$B$100").AutoFilter Field:=1, Criteria1:=NameArray(i)
'The copying and pasting code
End If

HasName = False

Next i

End Sub

另外，请注意，在录制宏后，您几乎可以随时使用 ActiveWindow.ScrollColumn 删除任何内容。这将使您的代码对其他人更具可读性。

【讨论】：