Sub FindAndRecord()Dim recordsSheet As WorksheetDim aSheet As WorksheetDim bSheet As WorksheetDim cSheet As WorksheetDim rowCount As LongDim i As LongDim searchValue As StringDim count As LongSet recordsSheet = ThisWorkbook.Sheets("记录")Set aSheet = ThisWorkbook.Sheets("A")Set bSheet = ThisWorkbook.Sheets("B")Set cSheet = ThisWorkbook.Sheets("C")' 获取记录表单中的最后一行rowCount = recordsSheet.Cells(recordsSheet.Rows.Count, 1).End(xlUp).Row' 遍历记录表单中的每个番号For i = 2 To rowCount ' 假设第一行为标题，从第二行开始遍历searchValue = recordsSheet.Cells(i, 1).Value ' 获取当前番号' 初始化计数器count = 0' 在 A 表中查找当前番号count = count + CountOccurrences(searchValue, aSheet)' 将番号、出现次数和出现在的表单位置记录到记录表单中recordsSheet.Cells(i, 2).Value = searchValuerecordsSheet.Cells(i, 3).Value = countrecordsSheet.Cells(i, 4).Value = GetSheetLocations(searchValue, aSheet)Next iMsgBox "查找并记录完成。"
End SubFunction CountOccurrences(searchValue As String, searchSheet As Worksheet) As LongDim lastCell As RangeDim searchRange As RangeDim foundCells As RangeDim count As Long' 查找范围为当前表中番号列的所有单元格Set lastCell = searchSheet.Cells.SpecialCells(xlCellTypeLastCell)Set searchRange = searchSheet.Range("A2:A" & lastCell.Row) ' 假设 A 表中的番号列为 A 列，且第一行是标题' 查找番号并计数Set foundCells = searchRange.Find(searchValue, LookIn:=xlValues, Lookat:=xlWhole)If Not foundCells Is Nothing ThenfirstAddress = foundCells.AddressDo' 找到一个匹配的番号count = count + 1Set foundCells = searchRange.FindNext(foundCells)Loop While Not foundCells Is Nothing And foundCells.Address <> firstAddressEnd IfCountOccurrences = count
End FunctionFunction GetSheetLocations(searchValue As String, searchSheet As Worksheet) As StringDim locations As String' 检查番号是否在指定表中出现If CountOccurrences(searchValue, searchSheet) > 0 Thenlocations = searchSheet.NameEnd IfGetSheetLocations = Trim(locations)
End Function
