Question

我为我们的一个上传模板创建了一个宏，该模板使用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

提前致谢！

Answer 1

我会浏览每张纸并检查#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

Answer 2

这应该在没有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

然后你可以在继续你的代码之前简单地调用这个检查，如果它是真的然后退出，如果它是假的则继续。

E.g。

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

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

2 个答案: