计算列中的连续数字
Count Consecutive Numbers in Column
我想计算列中连续数字的出现次数，但似乎找不到在循环中计算此值的逻辑方法。
我的值列只是 0 或 1 的条目。我想要的是每次出现连续两个 0、连续三个 0、连续四个 0 等等时进行计数。我期望连续数字的最大次数是 15.
理想情况下，我希望将每次出现的输出输入 table。
我在下面提供了相关列的快照。
到目前为止，我的尝试包括遍历列，从第 2 行开始连续检查两个 0，但是当我连续有两个以上的 0 时，这会导致问题。
'Check for 2
Dim TwoCount, RowNo As Integer, LastRow As Long
LastRow = Sheets("Data").Range("A165536").End(xlUp).Row
TwoCount = 0
RowNo = 2
For i = 2 To LastRow
If Sheets("Data").Range("H" & RowNo).Value = 1 Then
RowNo = RowNo + 1
Else
If Sheets("Data").Range("H" & RowNo).Value = 0 Then
TwoCount = 1
RowNo = RowNo + 1
If Sheets("Data").Range("H" & RowNo).Value = 0 Then
TwoCount = 2
RowNo = RowNo + 1
If Sheets("Data").Range("H" & RowNo).Value = 1 Then
End If
End If
End If
End If
Next i
我欢迎就如何处理此问题提出任何建议？无论是作为公式还是数组公式更容易。
期望的输出
想象一下 A 列中的数字 Win/Lose，然后在单元格 B3（不是 B2，这将保持为空）中添加以下公式并将其复制下来：
=IF(AND(A3=0,A3<>A4),COUNTIF($A:A3,A3)-SUM($B:B2),"")
然后在 F2 中使用 =COUNTIF(B:B,E2) 并复制下来。
计算列中连续出现 0 的频率
你也可以试试这个数组公式，
• 单元格 L2
中使用的公式
=SUMPRODUCT(--(FREQUENCY(
IF($H:$H=0,ROW($H:$H)),
IF($H:$H=1,ROW($H:$H)))=K2))
和向下填充!
注意：数组公式需要按CTRL+SHIFT+ENTER输入（不只是ENTER ).同时按住 CTRL 键和 SHIFT 键，然后按 ENTER。如果您使用的是 Excel 2021 或 O365 您只能按 ENTER.
计算连续出现的次数
Option Explicit
Sub CountConsecutive()
' Source
Const sName As String = "Data"
Const sFirstCellAddress As String = "H1"
Const sCriteria As Variant = 0
' Destination
Const dName As String = "Data"
Const dFirstCellAddress As String = "J1"
Dim dHeaders As Variant
dHeaders = VBA.Array("Occurrences", "Number of Times")
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Write the values from the source column to an array.
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim Data As Variant
Dim rCount As Long
With sws.Range(sFirstCellAddress)
Dim slCell As Range: Set slCell = .Resize(sws.Rows.Count - .Row + 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If slCell Is Nothing Then Exit Sub
rCount = slCell.Row - .Row + 1
If rCount < 2 Then Exit Sub
Data = .Resize(rCount).Value
End With
' Count the occurrences by using a dictionary.
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
Dim Key As Long
Dim r As Long
Dim cCount As Long
Dim MaxCount As Long
For r = 2 To rCount
Key = Data(r, 1)
If IsNumeric(Key) Then
If Key = sCriteria Then
cCount = cCount + 1
Else
If cCount > 0 Then
dict(cCount) = dict(cCount) + 1
If cCount > MaxCount Then MaxCount = cCount
cCount = 0
End If
End If
End If
Next r
If MaxCount = 0 Then Exit Sub
' Write the values from the dictionary to the array.
rCount = MaxCount + 1
ReDim Data(1 To rCount, 1 To 2)
Data(1, 1) = dHeaders(0)
Data(1, 2) = dHeaders(1)
For r = 2 To rCount
Data(r, 1) = r - 1
If dict.Exists(r - 1) Then
Data(r, 2) = dict(r - 1)
Else
Data(r, 2) = 0
End If
Next r
' Write the values from the array to the destination range.
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
With dws.Range(dFirstCellAddress).Resize(, 2)
.Resize(rCount).Value = Data
.Resize(dws.Rows.Count - .Row - rCount + 1).Offset(rCount).Clear
'.Font.Bold = True
'.EntireColumn.AutoFit
End With
'wb.save
MsgBox "Consecutive count created.", vbInformation
End Sub
在我看来，您可以通过两种方式阅读此要求：
- 您可以数出 1、2、3 和 4 在 4 个零的序列中出现的次数；
- 您只能计算以上出现次数的最大值；
我采用了后者的假设：
C1中的公式：
=LET(X,SEQUENCE(15),Y,LEN(TEXTSPLIT(CONCAT(IF(A2:A32," ",1)),," ",1)),VSTACK({"Occurences of 0","Number of Times"},HSTACK(X,BYROW(X,LAMBDA(a,SUM(--(Y=a)))))))
重要提示:
依赖 CONCAT() 可能不是最好的选择，因为根据您要连接的行数，它可能会达到字符数限制。相反，您可以尝试类似的方法：
=LET(X,SEQUENCE(15),Y,LEN(TEXTSPLIT(REDUCE("",A2:A32,LAMBDA(a,b,a&IF(b," ",1))),," ",1)),VSTACK({"Occurences of 0","Number of Times"},HSTACK(X,BYROW(X,LAMBDA(a,SUM(--(Y=a)))))))
此外，请注意，上述功能需要 ms365 才能正常 运行（并且在撰写本文时 VSTACK(), HSTACK() and TEXTSPLIT() 仍在内部人员的 BETA-channels.
我想计算列中连续数字的出现次数，但似乎找不到在循环中计算此值的逻辑方法。
我的值列只是 0 或 1 的条目。我想要的是每次出现连续两个 0、连续三个 0、连续四个 0 等等时进行计数。我期望连续数字的最大次数是 15.
理想情况下，我希望将每次出现的输出输入 table。 我在下面提供了相关列的快照。
到目前为止，我的尝试包括遍历列，从第 2 行开始连续检查两个 0，但是当我连续有两个以上的 0 时，这会导致问题。
'Check for 2
Dim TwoCount, RowNo As Integer, LastRow As Long
LastRow = Sheets("Data").Range("A165536").End(xlUp).Row
TwoCount = 0
RowNo = 2
For i = 2 To LastRow
If Sheets("Data").Range("H" & RowNo).Value = 1 Then
RowNo = RowNo + 1
Else
If Sheets("Data").Range("H" & RowNo).Value = 0 Then
TwoCount = 1
RowNo = RowNo + 1
If Sheets("Data").Range("H" & RowNo).Value = 0 Then
TwoCount = 2
RowNo = RowNo + 1
If Sheets("Data").Range("H" & RowNo).Value = 1 Then
End If
End If
End If
End If
Next i
我欢迎就如何处理此问题提出任何建议？无论是作为公式还是数组公式更容易。
期望的输出
想象一下 A 列中的数字 Win/Lose，然后在单元格 B3（不是 B2，这将保持为空）中添加以下公式并将其复制下来：
=IF(AND(A3=0,A3<>A4),COUNTIF($A:A3,A3)-SUM($B:B2),"")
然后在 F2 中使用 =COUNTIF(B:B,E2) 并复制下来。
计算列中连续出现 0 的频率
你也可以试试这个数组公式，
• 单元格 L2
中使用的公式=SUMPRODUCT(--(FREQUENCY(
IF($H:$H=0,ROW($H:$H)),
IF($H:$H=1,ROW($H:$H)))=K2))
和向下填充!
注意：数组公式需要按CTRL+SHIFT+ENTER输入（不只是ENTER ).同时按住 CTRL 键和 SHIFT 键，然后按 ENTER。如果您使用的是 Excel 2021 或 O365 您只能按 ENTER.
计算连续出现的次数
Option Explicit
Sub CountConsecutive()
' Source
Const sName As String = "Data"
Const sFirstCellAddress As String = "H1"
Const sCriteria As Variant = 0
' Destination
Const dName As String = "Data"
Const dFirstCellAddress As String = "J1"
Dim dHeaders As Variant
dHeaders = VBA.Array("Occurrences", "Number of Times")
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Write the values from the source column to an array.
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim Data As Variant
Dim rCount As Long
With sws.Range(sFirstCellAddress)
Dim slCell As Range: Set slCell = .Resize(sws.Rows.Count - .Row + 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If slCell Is Nothing Then Exit Sub
rCount = slCell.Row - .Row + 1
If rCount < 2 Then Exit Sub
Data = .Resize(rCount).Value
End With
' Count the occurrences by using a dictionary.
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare
Dim Key As Long
Dim r As Long
Dim cCount As Long
Dim MaxCount As Long
For r = 2 To rCount
Key = Data(r, 1)
If IsNumeric(Key) Then
If Key = sCriteria Then
cCount = cCount + 1
Else
If cCount > 0 Then
dict(cCount) = dict(cCount) + 1
If cCount > MaxCount Then MaxCount = cCount
cCount = 0
End If
End If
End If
Next r
If MaxCount = 0 Then Exit Sub
' Write the values from the dictionary to the array.
rCount = MaxCount + 1
ReDim Data(1 To rCount, 1 To 2)
Data(1, 1) = dHeaders(0)
Data(1, 2) = dHeaders(1)
For r = 2 To rCount
Data(r, 1) = r - 1
If dict.Exists(r - 1) Then
Data(r, 2) = dict(r - 1)
Else
Data(r, 2) = 0
End If
Next r
' Write the values from the array to the destination range.
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
With dws.Range(dFirstCellAddress).Resize(, 2)
.Resize(rCount).Value = Data
.Resize(dws.Rows.Count - .Row - rCount + 1).Offset(rCount).Clear
'.Font.Bold = True
'.EntireColumn.AutoFit
End With
'wb.save
MsgBox "Consecutive count created.", vbInformation
End Sub
在我看来，您可以通过两种方式阅读此要求：
- 您可以数出 1、2、3 和 4 在 4 个零的序列中出现的次数；
- 您只能计算以上出现次数的最大值；
我采用了后者的假设：
C1中的公式：
=LET(X,SEQUENCE(15),Y,LEN(TEXTSPLIT(CONCAT(IF(A2:A32," ",1)),," ",1)),VSTACK({"Occurences of 0","Number of Times"},HSTACK(X,BYROW(X,LAMBDA(a,SUM(--(Y=a)))))))
重要提示:
依赖 CONCAT() 可能不是最好的选择，因为根据您要连接的行数，它可能会达到字符数限制。相反，您可以尝试类似的方法：
=LET(X,SEQUENCE(15),Y,LEN(TEXTSPLIT(REDUCE("",A2:A32,LAMBDA(a,b,a&IF(b," ",1))),," ",1)),VSTACK({"Occurences of 0","Number of Times"},HSTACK(X,BYROW(X,LAMBDA(a,SUM(--(Y=a)))))))
此外，请注意，上述功能需要 ms365 才能正常 运行（并且在撰写本文时 VSTACK(), HSTACK() and TEXTSPLIT() 仍在内部人员的 BETA-channels.