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



我试图写一个vba代码来计算单词Juniors、Seniors、Masters、Grand Masters、Great Grand Master和Total of all在一列中出现的次数。我需要将结果粘贴到不同工作表上相应的单元格中。如果你能为我指明如何做到这一点的正确方向,将不胜感激

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

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

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

计数值

  • 调整常量部分中的值
  • 第二个过程只是用"伪随机"数据填充列的一种方法
  • 如果您不是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

最新更新