Question

我试图在一张纸上列出一个名单，检查它是否出现在第二张纸上，如果是，则在第三张纸上显示名称和出现的次数。

我在其他地方找到了一些代码，并尝试根据我的目的调整它。我已经使用 Do Until IsEmpty 来运行第一个工作表和两个嵌套的IF语句来检查名称是否出现在第二个工作表上，而COUNTIF来计算它们。

我以为我把所有东西都弄错了，但是当我尝试使用它时，它会运行一会儿然后挂断并冻结。我在VBA上很新，并且可能犯了一些非常简单的错误，但我对VBA找不到错误并不熟悉。

以下是我正在使用的代码。

Sub NS_FPS_Macro()
Dim NSName As String
Dim FPSCount As String

Application.ScreenUpdating = False

NSName = Worksheets("Summary_Report").Range("B2").Select

Do Until IsEmpty(Worksheets("Summary_Report").Range("B:B"))
    Sheets("FPS_Report").Activate
    If ActiveCell.Value = NSName Then
        Found = True
    End If

    If Found = True Then
        FPSCount = Application.WorksheetFunction.CountIf(Range(Worksheets("FPS_Report").Range("B:B")), NSName)
        Destination = Sheets("Report").Cells(Rows.Count, "A").End(xlUp).Offset(1)
    End If
ActiveCell.Offset(1, 0).Select
Loop

Application.ScreenUpdating = True

End Sub

Answer 1

无限循环的原因是Worksheets("Summary_Report").Range("B:B")永远不会为空。

Do Until IsEmpty(Worksheets("Summary_Report").Range("B:B"))

你可以这样解决：

Do Until IsEmpty(ActiveCell.Offset(1, 0))

但是你应该尽可能避免选择或激活。

Sub NS_FPS_Macro()
    Dim c As Range, CountRange As Range, NamesRange As Range, DestRange As Range
    Dim FPSCount As Long

    With Worksheets("FPS_Report")
        Set CountRange = Intersect(.UsedRange, .Range("B:B"))
    End With

    With Worksheets("Summary_Report")
        Set NamesRange = .Range("B2", .Range("B" & Rows.Count).End(xlUp))
    End With

    For Each c In NamesRange

        FPSCount = Application.WorksheetFunction.CountIf(CountRange, c.Text)
        If FPSCount > 0 Then

            Set DestRange = Sheets("Report").Cells(Rows.Count, "A").End(xlUp).Offset(1)
            DestRange.Value = c.Value
            DestRange.Offset(0, 1).Value = FPSCount

        End If
    Next

End Sub

Answer 2

这可能会对你有所帮助。它很可能需要进行修改以适合您的数据。它设置名称范围和查找范围，然后查找每个名称的查找。如果找到它，它会保持统计，并最终将其记录到单独的表格中。

Sub NameSearch()

Dim nameSource As range
Dim searchRange As range
Dim name As range
Dim counter As Integer
Dim openRow As Integer

'Keep track of how many times a name is found.
counter = 0

'The row where you want to store the data, mine is a blank sheet so I am starting
'at the first row.
openRow = 1

'Get the range that has the names to look for. Modify for your data.
Set nameSource = Sheets("Summary_Report").range("A1", "A4")

'Get the range to search for the name. Modify for your data.
Set searchRange = Sheets("FPS_Report").range("A1", "A15")

'Look through the search range. If a name is found, add one to the counter, and continue
For Each name In nameSource
    Set c = searchRange.Find(name.Value)
    If Not c Is Nothing Then
        firstAddress = c.address
        Do
            counter = counter + 1
            Set c = searchRange.FindNext(c)
        Loop While Not c Is Nothing And c.address <> firstAddress
    End If

    'If counter isn't 0, then name was found at least once
    If counter <> 0 Then
        Sheets("Report").range("A" & openRow).Value = name.Value
        Sheets("Report").range("B" & openRow).Value = counter

        'increment next row and reset counter
        openRow = openRow + 1
        counter = 0
    End If

Next name


End Sub

在VBA中使用COUNTIF遇到错误/冻结

2 个答案: