Excel VBA 如何将同一编号的全部匹配记录及出现次数写入工作表？

可以。宏需要逐行检查数据，收集匹配记录，然后将姓名、编号和总出现次数写入结果工作表。没有匹配记录时，再用 MsgBox 提示。

原代码只调用了一次 Range.Find，所以只能取得一个匹配单元格。如果仅把 MsgBox 改成写入单元格，仍然只能输出一条记录。

先确认工作表和列的位置

下面的示例采用这些约定：

• 数据位于 Data 工作表，第 1 行是标题，数据从第 2 行开始。
• C 列保存查询编号，D 列保存姓名。
• 查询结果写入同一工作簿中的 Results 工作表，需要提前创建这张表。

原代码中的 foundCell.Offset(0, 1) 表示从 C 列向右移动一列，实际读取的是 D 列。注释写的是 B 列，与代码行为不一致。如果姓名实际在 B 列，把下面的 NAME_COLUMN 改为 2。

请将 Results 用作专用结果表。每次查询时，宏都会清空它的 A

列内容，再写入本次结果。

可直接替换的 VBA 代码

这段代码逐行比较编号，不依赖 Find 的后续搜索状态。每条匹配记录输出一行，第三列显示该编号的总出现次数。

Option Explicit

Sub LookupUserInfo()
    Const FIRST_DATA_ROW As Long = 2
    Const NAME_COLUMN As Long = 4

    Dim wsData As Worksheet
    Dim wsResults As Worksheet
    Dim userPrompt As String
    Dim lastRow As Long
    Dim r As Long
    Dim i As Long
    Dim sourceRow As Long
    Dim cellValue As Variant
    Dim matchedRows As Collection
    Dim outputData() As Variant

    userPrompt = InputBox("Enter the number to look up:")
    If Len(userPrompt) = 0 Then Exit Sub

    Set wsData = ThisWorkbook.Worksheets("Data")
    Set wsResults = ThisWorkbook.Worksheets("Results")
    Set matchedRows = New Collection

    lastRow = wsData.Cells(wsData.Rows.Count, "C").End(xlUp).Row

    For r = FIRST_DATA_ROW To lastRow
        cellValue = wsData.Cells(r, "C").Value2

        If Not IsError(cellValue) Then
            If StrComp(CStr(cellValue), userPrompt, vbTextCompare) = 0 Then
                matchedRows.Add r
            End If
        End If
    Next r

    ReDim outputData(1 To matchedRows.Count + 1, 1 To 3)

    outputData(1, 1) = "Name"
    outputData(1, 2) = "Number"
    outputData(1, 3) = "Occurrences"

    For i = 1 To matchedRows.Count
        sourceRow = CLng(matchedRows(i))
        outputData(i + 1, 1) = wsData.Cells(sourceRow, NAME_COLUMN).Value2
        outputData(i + 1, 2) = CStr(wsData.Cells(sourceRow, "C").Value2)
        outputData(i + 1, 3) = matchedRows.Count
    Next i

    With wsResults
        .Columns("A:C").ClearContents

        If matchedRows.Count > 0 Then
            .Range("B2").Resize(matchedRows.Count, 1).NumberFormat = "@"
        End If

        .Range("A1").Resize(matchedRows.Count + 1, 3).Value2 = outputData
        .Columns("A:C").AutoFit
    End With

    If matchedRows.Count = 0 Then
        MsgBox "Information not found.", vbExclamation
    End If
End Sub

输出结果是什么样的

假设编号 12345 在 C 列出现三次，对应的姓名分别为 Alice、Bob、Alice，结果如下：

这里统计的是编号匹配的数据行数，不是不同姓名的数量。同一个姓名出现多次时，每条记录都会保留。

如果没有找到编号，宏会清除旧结果、保留标题行，并显示 Information not found.，避免结果表继续显示上一次查询的数据。

使用时需要注意什么

编号采用完整文本比较，忽略字母大小写，但不会自动去掉空格。例如，12345 与 12345 会被视为不同内容。C 列中的错误值会被跳过。

如果编号包含前导零，例如 00123，应在录入前将源数据列设置为文本。若单元格实际存储的是数值 123，只是通过格式显示为 00123，这段代码读取的仍然是 123。代码将结果编号列设为文本，只能保留源数据中仍然存在的前导零。

ThisWorkbook 指存放宏的工作簿，因此示例要求宏、Data 和 Results 位于同一个工作簿。如果宏存放在个人宏工作簿中，需要将工作簿引用改为实际的数据工作簿。

将代码放入标准模块，保存为支持宏的工作簿格式，例如 .xlsm，然后运行 LookupUserInfo。如果数据没有标题行，把 FIRST_DATA_ROW 改为 1。

备注：内容仅供参考。