如果其他VBA代码不起作用

I am new to VBA and I usually google for pieces of code I need however this has proven to be difficult. I am trying to create a macro that searches for a specific name and copies and pastes all rows with that name in a separate sheet. This worked fine but I also want a message box to appear when the name is not there. I added some code and now it only shows the message box even if the name is actually there. Below is my code. Many thanks for any help or information.

我是VBA的新手,我通常谷歌我需要的代码片段,但事实证明这很困难。我正在尝试创建一个搜索特定名称的宏,并在单独的工作表中复制和粘贴具有该名称的所有行。这工作正常,但我还想在名称不存在时出现一个消息框。我添加了一些代码,现在它只显示消息框,即使名称实际存在。以下是我的代码。非常感谢任何帮助或信息。

Private Sub CommandButton1_Click()

    Application.ScreenUpdating = False

    a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

    For i = 2 To a

        If Worksheets("Sheet1").Cells(i, 1).Value = "Aquino, Ervic" Then

            Worksheets("Sheet1").Rows(i).Copy
            Worksheets("Ervic Aquino").Activate
            b = Worksheets("Ervic Aquino").Cells(Rows.Count, 1).End(xlUp).Row
            Worksheets("Ervic Aquino").Cells(b + 1, 1).Select
            ActiveSheet.Paste
            Worksheets("sheet1").Activate

            Application.CutCopyMode = False

            Worksheets("Ervic Aquino").Activate
            Range("A1:K1").Select
            Range(Selection, Selection.End(xlDown)).Select
            Application.CutCopyMode = False
            Selection.Borders(xlDiagonalDown).LineStyle = xlNone
            Selection.Borders(xlDiagonalUp).LineStyle = xlNone
            With Selection.Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlInsideVertical)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            With Selection.Borders(xlInsideHorizontal)
                .LineStyle = xlContinuous
                .ColorIndex = 0
                .TintAndShade = 0
                .Weight = xlThin
            End With
            Range("I2").Select
            Range(Selection, Selection.End(xlToRight)).Select
            Range(Selection, Selection.End(xlDown)).Select
            Selection.ClearContents
            Range("H1").Select
            Selection.End(xlDown).Select
            ActiveCell.Offset(1).Select
            Selection.Font.Bold = True

            Dim LR As Long
            LR = Range("H" & Rows.Count).End(xlUp).Row
            Range("H" & LR + 1).Formula = "=SUM(H2:H" & LR & ")"

            Cells.Select
            Cells.EntireColumn.AutoFit
            Range("A2").Select

            'If there is no activity do nothing
        Else
            MsgBox "No Activity This Month"

            'End Loop
            Exit For

        End If

    Next

    Application.ScreenUpdating = True

End Sub

1 个解决方案

#1

Your current code is displaying your "No Activity This Month" message if any row does not contain "Aquino, Ervic" but you only want a message to be displayed if none of the rows contain that string.

如果任何行不包含“Aquino,Ervic”,您当前的代码将显示“本月无活动”消息,但如果没有行包含该字符串,则只需要显示消息。

The easiest, and probably most efficient, way to do this is to perform the test first and then only process each row if an entry exists:

最简单,也可能是最有效的方法是首先执行测试,然后仅在存在条目时处理每一行:

Private Sub CommandButton1_Click()
    Application.ScreenUpdating = False

    If Application.CountIf(Worksheets("Sheet1").Columns(1), "Aquino, Ervic") = 0 Then
        MsgBox "No Activity This Month"
    Else
        a = Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row

        For i = 2 To a
            If Worksheets("Sheet1").Cells(i, 1).Value = "Aquino, Ervic" Then
                Worksheets("Sheet1").Rows(i).Copy
                '...
                Cells.EntireColumn.AutoFit
                Range("A2").Select
            End If
        Next
    End If
    Application.ScreenUpdating = True
End Sub

I would also strongly recommend reading through the question How to avoid using Select in Excel VBA. Those Select and Activate statements will cause you so many problems in the future that it is better to invest some time now in learning how to get rid of them.

我还强烈建议阅读如何避免在Excel VBA中使用Select的问题。那些选择和激活语句将来会给你带来很多问题,现在花一些时间学习如何摆脱它们会更好。

#1