如果＃N / A存在于任何工作表中，需要防止用户运行macros
我为我们的一个上传模板创build了一个macros，它使用VLOOKUP公式来匹配描述和代码。 如果有新的描述，用户必须创build一个新的代码。 在他们创build新代码并且VLOOKUP返回匹配之后，还有一个额外的macros将复制/粘贴特殊/删除重复项以准备上传文件。 我想在后面的macros中join一些东西，在继续复制/粘贴特殊/删除重复项之前，检查是否有任何突出的VLOOKUP错误。 总共有9个工作表，行号会有所不同。
我发现这个函数检查＃N / A，但不知道在现有的macros中使用它的最好方法：
Application.WorksheetFunction.IsNA(rngToCheck.Value) 这是我目前使用的复制/粘贴特殊/删除重复的macros：
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
提前致谢！
我会仔细检查每张表格，并检查＃N / A，如果可能的话继续。
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
然后你可以在继续你的代码之前简单地调用这个检查，如果它是真的然后退出，如果它是假的，然后继续。
例如
If FindNA then 'Don't continue Else 'Continue End If