计算某些单词在列中出现的次数
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
我正在尝试编写一个 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