Excel VB计数直到更改

Question

我不会对VB做太多事情，需要一些帮助来计算/计算给定值的实例数。  数据在A列中并按值排序，因此所有结果一起只需要持续计数，直到值更改或单元格为空。

工作表示例

Sub Rec_Label()
Path = "%UserProfile%"
Set ws = CreateObject("WScript.Shell")
fullpath = ws.ExpandEnvironmentStrings(Path)
'Create lines for number of labels based on Column "G"

 ActiveSheet.Copy Before:=ActiveSheet
 Application.ScreenUpdating = False
 Dim vRows As Long, v As Long
 On Error Resume Next
 Dim ir As Long, mrows As Long, lastcell As Range
 Set lastcell = Cells.SpecialCells(xlLastCell)
 mrows = lastcell.Row
 For ir = mrows To 2 Step -1
  If Not IsNumeric(Cells(ir, 7)) Then
   Cells(ir, 1).EntireRow.Delete
  ElseIf Cells(ir, 1).Value > 1 Then
   v = Cells(ir, 1).Value - 1
   Rows(ir + 1).Resize(v).Insert Shift:=xlDown
   Rows(ir).EntireRow.AutoFill Rows(ir). _
     EntireRow.Resize(rowsize:=v + 1), xlFillCopy
   ElseIf Cells(ir, 1).Value < 1 Then
      Cells(ir, 1).EntireRow.Delete
   End If
  Next ir

'Fill-in Count based on column A

Answer 1

在B2中，您可以使用此功能并向下拖动：

=COUNTIF($A$2:$A2,A2)

Answer 2

这是一个子程序，它将执行你想要的功能。请注意，它假设数据在A2：n中，所需结果在B2：n中。希望如何将它集成到您​​的整体代码中非常明显。

Sub CountValues()
Dim Row As Integer
Dim Last As Integer
Dim Count As Integer
Dim V As String

Last = 0
Row = 2
Count = 1
V = Application.ActiveSheet.Cells(Row, 1).Value
Do While V <> ""
    If Int(V) <> Last Then
        Count = 1
        Last = Int(V)
    Else
        Count = Count + 1
    End If
    Application.ActiveSheet.Cells(Row, 2).Value = Count
    Row = Row + 1
    V = Application.ActiveSheet.Cells(Row, 1).Value
Loop
End Sub