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

时间:2013-05-19 21:24:30

标签: excel excel-vba excel-2007 excel-2010 vba

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

我有这组数据,大约有4000条记录以我想要跟踪的模式出现。 第一列是重要的一栏。我想在列中进行扫描并在新列中记录该数字是如何发生的。是否可以在Excel中以编程方式执行此操作?

注意:我不只是寻找单个模式或单个模式。

E.g。在这个样本313中发生1次,314次发生6次,315次发生2次等等。

在发生结束时,我希望它看起来像

--- 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  

13年5月23日 数据由空格分隔。它不是一个单元格。 我不知道如何在这里创建网格图片。 最左边的单元格是我想要计算的单元格。

所需的输出就是我想要的例子。有6次出现314,我希望计数摘要单元格在最后一次出现的行中编译。

4 个答案:

答案 0 :(得分:1)

我支持,放慢速度并采用一些基本的编程原则,有时会感觉很慢。

  1. 流程
  2. 伪代码
  3. 原型
  4. 测试
  5. 根据需要重复3和4。
  6. 我发现以下代码完全符合我的要求。 我为任何跟随的人分享。

    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
    

答案 1 :(得分:0)

如果您只想计算特定范围内某个数字的发生次数,您只需要使用 COUNTIF(范围,条件)

其中range是您要检查的单元格(根据您将是“A1:A4000”),条件是您正在寻找的数字,它也可以是像“&gt; 55”那样的单位计算该值大于55的单元格数。

希望它有所帮助, 布鲁诺

我在评论中提到的代码:

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

如果我在最新评论中描述的是您真正想要的,那么您只需将此公式粘贴到B1 = COUNTIF($ A $ 1:A1; A1)并将其拖动到最后一个单元格或双击其中在B1底部角落的blac square,然后如果计算是自动完成的话,如果它是手动的你必须现在点击计算并且它已经完成

希望它有所帮助, 布鲁诺

答案 2 :(得分:0)

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

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

根据需要调整范围。该公式假设前3个数字位于自己的单元格中。

如果您的示例数据全部在一列中,则必须使用Sumproduct代替cou Left =IF(LEFT(A1,3)<>LEFT(A2,3),SUMPRODUCT(--(LEFT($A$1:$A$100000,3)=LEFT(A1,3))),"") 函数。在这种情况下,您可以使用以下公式,但如果您的样本数据在3列中,则可以使用我的快速公式。

countif

编辑 根据您的评论和回答,我已经提供了使用CountColumn方法的完整指南,因为VBA 始终<如果可能,请避免使用/ em> 。您遇到问题是因为您的问题中提供的示例数据不包含标题/列标签这里是固定指南。

从带有标题的3列开始,我要在列上创建一个命名范围,就像使用内置在Name Manager中的计数一样,然后单击new:

Name Manager New

然后从此设置名称到=OFFSET($A$2,0,0,COUNTA($A$2:$A$1000000),1) 并在公式中使用以下内容:

D2

Name Manager Formula

现在使用原始答案的修改版本在单元格=IF(A3<>A2,COUNTIF(CountColumn,A2),"") 中输入以下内容:

Desired Output

Formula

如上所示,这与您在CountColumn中提出的原始问题的身份相符。

现在为了进一步了解您的VBA代码看起来要做的亮点,我将使用以下内容。

返回到名称管理器,就像我们对Sums所做的那样,创建另一个名为A的新命名范围,然后将所有D引用更改为=OFFSET($D$2,0,0,COUNTA($D$2:$D$1000000),1) 如下:

Sums

SumsNamed

您的名称管理员应如下所示:

Name Manager2

现在在名称框(公式栏旁边的左上方框)中输入单词sums以选择整个总和区域,以便我们对其进行格式化:

Sums

然后在{{1}}区域突出显示时**** ***转到条件格式~~&gt;新规则:

enter image description here 并使用内置的无空白功能:

NO Blanks

然后使用格式使用填充和您想要的颜色,根据您发布的公式,我使用了绿色:

Fill Green

现在你应该完成,你的数据应如下图所示:

Finish

答案 3 :(得分:0)

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

它将从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