计算某些单词在列中出现的次数

Count the number of times certain words appear in a column

我正在尝试编写一个 vba 代码来计算“初级”、“高级”、“大师”、“大师”、“大师”和“总计”这些词在一列中出现的次数。我需要将结果粘贴到不同 Sheet 上的相应单元格中。如果您能为我指出正确的操作方法,将不胜感激

我已经准备了一些基本代码来为您指明正确的方向。假设信息存储在第一列中,我只为前两个词实现了它。您可以简单地将变量列的值更改为适当的值。此外,只要未找到任何空单元格,此代码就会循环。

Sub Count()
    Dim Juniors As Integer 'Counts how many times the word Juniors appears
    Dim Seniors As Integer 'Counts how many times the word Seniors appears
    Dim column As Integer 'column with data
    Dim row As Integer 'iterated row
    Dim CellValue As String 'value of the cell iterated
    
    Juniors = 0
    Seniors = 0
    row = 1
    column = 1
    
    
    Do While Not IsEmpty(Cells(row, column))
        CellValue = Cells(row, column)
        
        If CellValue = "Juniors" Then
            Juniors = Juniors + 1
        ElseIf CellValue = "Seniors" Then
            Seniors = Seniors + 1
        End If
        
        row = row + 1
    Loop
    
    'Stores the counters
    Cells(1, 4) = "Juniors"
    Cells(1, 5) = Juniors
    Cells(2, 4) = "Seniors"
    Cells(2, 5) = Seniors
    
        
End Sub
Sub NameCount()
Dim MyRange As Range

Set MyRange = Sheet2.Range("A1", Sheet2.Range("A1").End(xlDown))

Sheet2.Range("d2").Value = "Junior"
Sheet2.Range("d3").Value = "Seniors"
Sheet2.Range("d4").Value = "Masters"
Sheet2.Range("d5").Value = "Grand Masters"
Sheet2.Range("d6").Value = "Great Grand Master"

Sheet2.Range("e2").Value = WorksheetFunction.CountIf(MyRange, MyRange.Find("Junior"))
Sheet2.Range("e3").Value = WorksheetFunction.CountIf(MyRange, MyRange.Find("Seniors"))
Sheet2.Range("e4").Value = WorksheetFunction.CountIf(MyRange, MyRange.Find("Masters"))
Sheet2.Range("e5").Value = WorksheetFunction.CountIf(MyRange, MyRange.Find("Grand Masters"))
Sheet2.Range("e6").Value = WorksheetFunction.CountIf(MyRange, MyRange.Find("Great Grand Master"))


End Sub

计数值

  • 调整常量部分中的值。
  • 第二个过程只是一种用 'pseudo-random' 数据填充列的方法。
  • 如果你不是OP,那么你可以打开一个新的工作簿,将代码复制到标准模块中,例如Module1 和 运行 第二个程序在 Sheet1 中获取数据然后 运行 第一个程序在 Sheet2 中查看结果。

代码

Option Explicit

Sub countValues()
    
    ' Define constants.
    Const srcName As String = "Sheet1"
    Const srcFirstCell As String = "A1"
    Const srcFirstCellValue As String = "Title"
    Const dstName As String = "Sheet2"
    Const dstFirstCell As String = "A1"
    Const dstFirstTitle As String = "Title"
    Const dstSecondTitle As String = "Count"
    Const dstFooter As String = "Total"
    Const DataList As String = "Juniors,Seniors,Masters,Grand Masters," _
        & "Great Grand Master"
    Dim wb As Workbook: Set wb = ThisWorkbook ' Workbook containing this code.
    
    ' Define Data Range.
    Dim rng As Range
    With wb.Worksheets(srcName).Range(srcFirstCell)
        ' Define range from first cell to bottom-most cell.
        Set rng = .Resize(.Worksheet.Rows.Count - .Row + 1)
        ' Define Last Non-Empty Cell.
        Set rng = rng.Find(What:="*", LookIn:=xlFormulas, _
            SearchDirection:=xlPrevious)
        ' Validate Last Non-Empty Cell.
        If rng Is Nothing Then
            MsgBox "No data found.", vbCritical, "No Data"
            Exit Sub
        End If
        ' Define Source Range.
        Set rng = .Resize(rng.Row - .Row + 1)
        Debug.Print rng.Address
        ' Define Data Range (exclude headers).
        Set rng = rng.Resize(rng.Rows.Count - 1).Offset(1)
        Debug.Print rng.Address
    End With
    
    ' Write values from Data List (string) to Data Array.
    Dim Data() As String: Data = Split(DataList, ",")
    Dim DataUpper As Long: DataUpper = UBound(Data)
    
    ' Define Result Array.
    Dim Result As Variant: ReDim Result(1 To DataUpper + 3, 1 To 2)
    ' '+ 3' means:
    '     1 - because Data Array is 0 based,
    '     1 - for header,
    '     1 - for footer.
    
    ' Write headers.
    Result(1, 1) = dstFirstTitle
    Result(1, 2) = dstSecondTitle
    ' Write body.
    Dim Tot As Long
    Dim n As Long
    For n = 0 To DataUpper
        Result(2 + n, 1) = Data(n)
        Result(2 + n, 2) = Application.CountIf(rng, Data(n))
        Tot = Tot + Result(2 + n, 2)
    Next n
    ' Write footer (total).
    Result(n + 2, 1) = dstFooter
    Result(n + 2, 2) = Tot
        
    ' Write from Result Array to Result Range (in Destination Worksheet).
    With wb.Worksheets(dstName)
        With .Range(dstFirstCell)
            .Resize(UBound(Result, 1), 2).Value = Result
        End With
    End With

End Sub

Sub populateSourceWorksheet()
    
    Const wsName As String = "Sheet1"
    Const FirstCell As String = "A1"
    Const FirstCellValue As String = "Title"
    Const DataList As String = "Juniors,Seniors,Masters,Grand Masters," _
        & "Great Grand Master"
    Const PopCount As Long = 100
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim Data() As String: Data = Split(DataList, ",")
    Dim DataUpper As Long: DataUpper = UBound(Data)
    Dim Result As Variant: ReDim Result(1 To PopCount, 1 To 1)
    Dim n As Long
    For n = 1 To PopCount
        Result(n, 1) = Data(Int(Rnd() * (DataUpper + 1)))
        Debug.Print Data(Int(Rnd() * (DataUpper + 1)))
    Next n
    
    With wb.Worksheets(wsName)
        With .Range(FirstCell)
            .Value = FirstCellValue
            .Offset(1).Resize(UBound(Result)).Value = Result
        End With
    End With
End Sub