Vba 如果任何工作表中存在N/A，则需要阻止用户运行宏

我为我们的一个上传模板创建了一个宏，它使用VLOOKUP公式将描述与代码匹配。如果有新的描述，用户必须创建新代码。创建新代码后，VLOOKUP返回一个匹配项，另外还有一个宏将复制/粘贴特殊/删除重复项，以准备上传文件。我想在后一个宏中加入一些东西，在继续复制/粘贴特殊项/删除重复项之前，检查是否存在任何未解决的VLOOKUP错误。共有9张工作表，行号会有所不同

我发现此函数用于检查N/A，但不确定在现有宏中使用它的最佳方式：

Application.WorksheetFunction.IsNA(rngToCheck.Value)

以下是我当前使用的“复制/粘贴特殊/删除重复项”宏：

Sub PasteSpecialAndRemoveDups()
 Application.ScreenUpdating = False
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("1_Vendor_Upload").Select
    Cells.Select
    Range("A:D").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("2_Lines").Select
    Cells.Select
    Range("A:C").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("3_Parts_Info_Brand").Select
    Cells.Select
    Range("A:B").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("4_Vendor_Brand").Select
    Cells.Select
    Range("A:B").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("5_Product_Line_Catalog_Type").Select
    Cells.Select
   Range("A:B").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("6_Product_Lines_Catalog").Select
    Cells.Select
    Range("A:F").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("7_Vendor_Catalogs").Select
    Cells.Select
    Range("A:B").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("8_Vendor_Users").Select
    Cells.Select
    Range("A:B").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("9_Parts").Select
    Cells.Select
    Range("A:P").Activate
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("1_Vendor_Upload").Select
    Application.CutCopyMode = False
    Cells.Select
    Sheets("1_Vendor_Upload").Select
    ActiveSheet.UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3, 4), Header:=xlYes
    Sheets("2_Lines").Select
    ActiveSheet.UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3), Header:=xlYes
    Sheets("3_Parts_Info_Brand").Select
    ActiveSheet.UsedRange.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
    Sheets("4_Vendor_Brand").Select
    ActiveSheet.UsedRange.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
    Sheets("5_Product_Line_Catalog_Type").Select
    ActiveSheet.UsedRange.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
    Sheets("6_Product_Lines_Catalog").Select
    ActiveSheet.UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6), Header:=xlYes
    Sheets("7_Vendor_Catalogs").Select
    ActiveSheet.UsedRange.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
    Sheets("8_Vendor_Users").Select
    ActiveSheet.UsedRange.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
    Sheets("9_Parts").Select
    ActiveSheet.UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, _
        7, 8, 9, 10, 11, 12, 13, 14, 15, 16), Header:=xlYes
        Application.ScreenUpdating = True
        MsgBox "Done"
End Sub

---

提前谢谢

我会仔细检查每张表，检查是否有不适用项，如果可能的话，再继续

Sub PasteSpecialAndRemoveDups() 
Dim sSheetsWithErrors As String
sSheetsWithErrors = vbNullString

If Application.WorksheetFunction.IsNA(Sheets("1_Vendor_Upload").Cells.Value) Then
    sSheetsWithErrors = sSheetsWithErrors & ", "
End If
'Continue for each sheet

If Len(sSheetsWithErrors) > 0 Then
    sSheetsWithErrors = Left(sSheetsWithErrors, Len(sSheetsWithErrors) - 2) 'Remove trailing comma...
    MsgBox "There were errors found on the following sheets:" & vbCr & sSheetsWithErrors 'customize as desired
Else
'The rest of your Sub goes here
End If

End Sub

另外，使用Thing.Select，然后使用Selection.DoStuff会更慢、更麻烦。通常也可以通过直接跳到Thing.DoStuff来实现。如果您需要执行多个“DoStuff”步骤，请尝试：

With Thing
    .DoStuff1
    .DoStuff2
End With

---

在没有IsNA的情况下，这应该可以做到：

Function FindNA() As Boolean

    Dim sht As Worksheet

        For Each sht In Application.Worksheets

        If Application.WorksheetFunction.CountIf(sht.Range("A:Z"), "#N/A") > 0 Then
            FindNA = True
            Exit Function
        End If

        Next

        FindNA = False

End Function

然后，您可以在继续代码之前调用此检查，如果为真，则退出，如果为假，则继续

例如

---

视情况而定，您是希望宏跳到下一页并继续，还是希望结束该过程并警告用户？是的，我希望该过程结束并警告用户文件中存在N/A值。您是否需要先扫描所有工作表并中止（如果有）包含N/A，或者例如，如果在第三页上失败，你会让前两个顺利通过吗？@Mattdonan说得好。。。我的回答是先检查所有的。否则，您需要为每张工作表分割If检查。我需要它扫描所有工作表，如果存在任何N/A值，则不在任何工作表上开始复制/粘贴特殊/删除重复项过程。谢谢，Gaffi。我将此添加到代码中，并仅使用第一个工作表进行测试，但收到以下错误：运行时错误“7”：此行内存不足：If Application.WorksheetFunction.IsNASheets1\u Vendor\u Upload.Cells.Value ThenOops…我找到了答案。我忘了把手机的位置放进去。这是完美的工作。非常感谢。我也犯了同样的错误，在没有IsNa的情况下，我确实找到了另一个选择，尽管我担心这花费了我太长的时间：无论如何，看看。很高兴我能帮上忙@无论如何，马特唐南的解决方案也应该有效。我对vba还是相当陌生的。我在一个模块中插入了该函数，并查看该函数是否可用，但我不确定如何使用它。

If FindNA then
    'Don't continue
Else
    'Continue
End If