vba 如何计算 Excel 中数据模式的出现次数？

How do I count occurrences of a pattern of data in Excel?

提问by Ken Ingram

I realized after manual scanning 90 records, that this was going to be painful and tedious unless I made use of automation.

我在手动扫描 90 条记录后意识到，除非我使用自动化，否则这将是痛苦和乏味的。

I have this set of data, about 4000 records that occurs in a pattern that I want to track. The first column is the important one. I want to scan through the column and record in a NEW column how man times that number has occurred. Is it possible to do this programatically in Excel?

我有这组数据，大约 4000 条记录以我想要跟踪的模式出现。第一列是重要的。我想浏览该列并在新列中记录该数字发生的人次。是否可以在 Excel 中以编程方式执行此操作？

Note: I'm not just looking for a single pattern or single occurrence of a pattern.

注意：我不只是在寻找单一模式或模式的单一出现。

E.g. in this sample 313 occurs 1 time, 314 occurs 6 times, 315 occurs 2 times, etc.

例如，在这个样本中，313 出现了 1 次，314 出现了 6 次，315 出现了 2 次，等等。

At the end of the occurrences I want it to look like

在事件结束时，我希望它看起来像

--- Desired Output -------

313 1       343  1
314 1   344  
314 2   344 
314 3   344
314 4   344
314 5   344  
314 1   345  6
315 2   345  
315 1   346  2


-- Sample Data ------------------------------------
313 1   343
314 1   344
314 2   344
314 3   344
314 4   344
314 5   344
314 1   345
315 2   345
315 1   346
316 2   346
316 1   347
317 2   347
318 1   348
318 2   348
319 1   349
319 2   349
319 3   349  

5/23/13 The data is delimited by the spaces. It is not all in one cell. I don't know how to create a grid picture here. The leftmost cell is the one I want counted.

5/23/13 数据由空格分隔。并非全部都在一个单元格中。我不知道如何在这里创建网格图片。最左边的单元格是我想要计数的单元格。

The desired output is the example of what I want. There are six occurrences of 314, I want the count summary cell to be compiled in the row of the last occurrence.

所需的输出是我想要的示例。314 出现了六次，我希望将计数汇总单元格编译在最后一次出现的行中。

采纳答案by Ken Ingram

I backed up, slowed down and went to some basic programming principles, as slow as they feel at times.

我后退，放慢速度，然后转向一些基本的编程原则，尽管有时感觉很慢。

1. Flowchart
2. Pseudocode
3. prototype
4. test
5. repeat 3 and 4 as needed.

1. 流程图
2. 伪代码
3. 原型
4. 测试
5. 根据需要重复 3 和 4。

I found that the following code did EXACTLY what I needed. I share it for any who follow.

我发现以下代码完全符合我的需要。我分享给任何关注的人。

Sub countFoo()
Dim startCell As Range
Dim preCell As Range
Dim counter As Integer
Dim startPoint As Range, endPoint As Range
Dim fileName As String, delimitingCharacter As String, SQLpre As String, SQLpost As String
Dim SQL As String
Dim outfile As Integer

fileName = "update_foo.sql"
SQLpre = "UPDATE foo SET foodata = "
SQLpost = " WHERE details = '"
outfile = FreeFile()
Open fileName For Output As outfile
counter = 1

Set startPoint = Cells(2, 4)
startPoint.Activate

Debug.Print "Start Point:" & startPoint.Address
Debug.Print startPoint.Value

Set startCell = ActiveCell
Set preCell = startCell.Offset(-1, 0)


Do While startCell.Value <> "END"

If (startCell.Value = preCell.Value) Then
  counter = counter + 1
  Set preCell = startCell
  Set startCell = startCell.Offset(1, 0)
ElseIf ((startCell.Value <> preCell.Value) Or (startCell.Value = "END")) Then
  startCell.Offset(-1, 3).Value = counter
  If counter > 1 Then
    startCell.Offset(-1, 0).Interior.Color = 5296274
    startCell.Offset(-1, 1).Interior.Color = 5296274
    startCell.Offset(-1, 2).Interior.Color = 5296274
    startCell.Offset(-1, 3).Font.Bold = True
    With startCell.Offset(-1, 3).Interior
      .Pattern = xlGray8
      .PatternColor = 65535
      .Color = 5296274
    End With
  End If
  SQL = SQLpre & counter & SQLpost & startCell.Offset(-1, 0).Value & "';"
  Print #outfile, SQL
  counter = 1
  Set preCell = startCell
  Set startCell = startCell.Offset(1, 0)
End If
Loop
Close #outfile
End Sub

回答by Newbie

If all you want to do is count the number of ocurrences of a certain numer in a certain range all you have to do is use COUNTIF(range,criteria)

如果您只想计算某个范围内某个数字的出现次数，您所要做的就是使用 COUNTIF(range,criteria)

where range is the cells where you want to check ( according to you it would be "A1:A4000") and criteria is the number you are loonking for, it can also be an ocrrence like ">55" where it counts how many cells the value is bigger than 55.

其中 range 是您要检查的单元格（根据您的说法，它将是“A1：A4000”），而标准是您正在寻找的数字，它也可以是像“> 55”这样的 ocrrence，它计算有多少个单元格该值大于 55。

Hope it helps, Bruno

希望它有所帮助，布鲁诺

The code i mentioned in the comment:

我在评论中提到的代码：

CurrentRowA = 1
LastRowA = Range("A50000").End(xlUp).Row
Dim r As Range
While CurrentRowA <= LastRowA
    CurrentRowB = 1
    LastRowB = Range("B50000").End(xlUp).Row
    Do While CurrentRowB <= LastRowB
        If Cells(CurrentRowA, "A").Value = Cells(CurrentRowB, "B").Value Then
            Exit Do
        Else
        CurrentRowB = CurrentRowB + 1
        End If
    Loop
    If CurrentRowB > LastRowB Then
        Cells(CurrentRowB, "B").Value = Cells(CurrentRowA, "A").Value
        Set r = Range("A1", "A" & LastRowA)
        Cells(CurrentRowB, "C").Value = Application.CountIf(r, Cells(CurrentRowA, "A").Value)
    End If
    CurrentRowA = CurrentRowA + 1
Wend
LastRowB = Range("B50000").End(xlUp).Row
Range("B2", "C" & LastRowB).Cut
Range("B1").Select
ActiveSheet.Paste

If what i described in my latest comment is what you really want all you have to do is paste this formulas in B1 =COUNTIF($A$1:A1;A1) and drag it to the last cell or double click in that blac square on B1 bottomtight corner, then if the calcution is automatic it's done, if it's manual you have to click calculate now and it's done

如果我在我的最新评论中描述的是您真正想要的，那么您所要做的就是将此公式粘贴到 B1 =COUNTIF($A$1:A1;A1) 并将其拖到最后一个单元格或双击那个黑色方块B1底角，如果是自动计算就完成了，如果是手动你必须点击现在计算就完成了

Hope it helps, Bruno

希望它有所帮助，布鲁诺

回答by user2140261

Paste this in D1 and drag down.

将其粘贴到 D1 中并向下拖动。

=IF(A2<>A1,COUNTIF($A:$A0000,A1),"")

Adjust the range as you need. This formula assumes that the first 3 digits are in there own cell.

根据需要调整范围。此公式假定前 3 位数字在其自己的单元格中。

If your sample data is all in one column then you will have to use a Sumproductwith a Leftfunction in place of the countif. You can use the following Formula in this case, But if your sample data is in 3 columns definatly use my fast formula.

如果您的样本数据都在一列中，那么您将不得不使用Sumproduct一个Left函数来代替 countif。在这种情况下，您可以使用以下公式，但如果您的样本数据在 3 列中，请务必使用我的快速公式。

=IF(LEFT(A1,3)<>LEFT(A2,3),SUMPRODUCT(--(LEFT($A:$A0000,3)=LEFT(A1,3))),"")

EDITBased on your comments and answer I have made a full guide on using the countifmethod as VBA should ALWAYSbe avoided if possible. You had issues because your sample data provided in your question did not contain headers/ Column Labels here is the fixed guide.

编辑根据您的评论和回答，我已经制作了有关使用该countif方法的完整指南，因为如果可能，应始终避免使用VBA。您遇到了问题，因为您在问题中提供的示例数据不包含标题/列标签，这里是固定指南。

Starting with your 3 columns with headers I wqould create a named range on the column youd like the counts for to do this use built in Name Manager and click on new:

从带有标题的 3 列开始，我将在您想要计数的列上创建一个命名范围，以使用内置的名称管理器并单击新建：

Then from this Set the Name to CountColumnand in the Formula use the following:

然后从此将名称设置为CountColumn并在公式中使用以下内容：

=OFFSET($A,0,0,COUNTA($A:$A00000),1)

Now using a modified version of my original answer type the following in cell D2:

现在使用我的原始答案的修改版本在单元格中键入以下内容D2：

=IF(A3<>A2,COUNTIF(CountColumn,A2),"")

AS shown above this is IDENTICAL to what your original question Asked for in Desired Output.

如上所示，这与您在 中提出的原始问题相同Desired Output。

Now to further this to get the highlights as your VBA Code looks to do I would use the following.

现在为了进一步了解您的 VBA 代码想要做的重点，我将使用以下内容。

Go Back to the Name Manager, as we did for the CountColumn, and Create another new Named Range called SumsAnd then change all the Areferences to Dlike follows:

回到名称管理器，就像我们对CountColumn, 和 创建另一个名为 的新命名范围Sums然后将所有A引用更改为D如下所示：

=OFFSET($D,0,0,COUNTA($D:$D00000),1)

And you Name Manager Should look like the following:

您的名称管理器应如下所示：

Now in the Name Box (top left box next to formula bar) type in the word Sumsto select the entire sum area so we can format it:

现在在名称框（公式栏旁边的左上角框）中输入单词Sums以选择整个求和区域，以便我们可以对其进行格式化：

Then ****while sumsarea is highlighted*** go to Conditional Formatting ~~> New Rule:

然后****同时sums突出显示区域***转到条件格式~~>新规则：

And use the built in No Blanks Function:

并使用内置的 No Blanks 函数：

Then for the format Use Fill and the color you want, Based on your posted formula I used the Green Color:

然后对于格式使用填充和您想要的颜色，根据您发布的公式，我使用了绿色：

Now you should be done and your Data should look as the picture below does:

现在你应该完成了，你的数据应该如下图所示：

回答by NickSlash

The following assumes that your data is all in one column (eg: "315 1 344"is one cell)

以下假设您的数据全部在一列中（例如："315 1 344"是一个单元格）

It will look at sheet1 starting from A1, generate a list of unique cell values and count any duplicates. Once all the records have been checked, it outputs the results to sheet2.

它将查看从 A1 开始的 sheet1，生成唯一单元格值的列表并计算任何重复项。检查完所有记录后，它将结果输出到 sheet2。

Sub Main()
' this requires you to add a reference to "Microsoft Scripting Runtime" (usefull if you do not know the methods of scripting.dictionary)
'Dim Results As New Scripting.Dictionary
' the line does not require you to add any extra references (there is no code-completion, you must know the methods and their arguments)
Dim Results As Object: Set Results = CreateObject("Scripting.Dictionary")
Dim Data As Variant
Dim Key As Variant
Dim Source As Worksheet: Set Source = ThisWorkbook.Worksheets("Sheet1") ' the sheet where your data is
Dim Destination As Worksheet: Set Destination = ThisWorkbook.Worksheets("Sheet2") ' where the results will be put
Dim Row As Long: Row = 1 ' the row number to start from
Dim Item As String
Data = Source.UsedRange.Value2
' iterate over the data
Do
    Item = Data(Row, 1)
    If Results.Exists(Item) = True Then
        Results(Item) = Results(Item) + 1
    Else
        Results(Item) = 1
    End If
    Row = Row + 1
Loop While Not Data(Row, 1) = ""
' display the output
Destination.Cells.Clear ' reset the worksheet
For Each Key In Results.Keys ' loop through the results
    Destination.Range("A1:B1").Insert xlShiftDown ' move the previous results down
    Destination.Cells(1, 1) = Key
    Destination.Cells(1, 2) = Results(Key)
Next Key

End Sub