使用vba写代码练习

最新推荐文章于 2024-12-30 19:45:00 发布

Yesdodo

最新推荐文章于 2024-12-30 19:45:00 发布

阅读量229

点赞数

文章标签：前端 javascript 服务器 python

本文链接：https://blog.csdn.net/weixin_44904285/article/details/131819091

版权

该VBA宏在名为记录的工作表中查找指定番号在A、B和C表中的出现次数，并将结果记录回记录表。它遍历记录表的每一行，使用CountOccurrences函数计算番号在A表的A列中的出现频率，并使用GetSheetLocations函数记录所在位置。

摘要生成于 C知道，由 DeepSeek-R1 满血版支持，前往体验 >

Sub FindAndRecord()
    Dim recordsSheet As Worksheet
    Dim aSheet As Worksheet
    Dim bSheet As Worksheet
    Dim cSheet As Worksheet
    Dim rowCount As Long
    Dim i As Long
    Dim searchValue As String
    Dim count As Long
    
    Set 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 = searchValue
        recordsSheet.Cells(i, 3).Value = count
        recordsSheet.Cells(i, 4).Value = GetSheetLocations(searchValue, aSheet)
    Next i
    
    MsgBox "查找并记录完成。"
End Sub

Function CountOccurrences(searchValue As String, searchSheet As Worksheet) As Long
    Dim lastCell As Range
    Dim searchRange As Range
    Dim foundCells As Range
    Dim 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 Then
        firstAddress = foundCells.Address
        Do
            ' 找到一个匹配的番号
            count = count + 1
            Set foundCells = searchRange.FindNext(foundCells)
        Loop While Not foundCells Is Nothing And foundCells.Address <> firstAddress
    End If
    
    CountOccurrences = count
End Function

Function GetSheetLocations(searchValue As String, searchSheet As Worksheet) As String
    Dim locations As String
    
    ' 检查番号是否在指定表中出现
    If CountOccurrences(searchValue, searchSheet) > 0 Then
        locations = searchSheet.Name
    End If
    
    GetSheetLocations = Trim(locations)
End Function