查找連續值的計數

Question

我試圖找到連續值的計數，以便將其更改為另一個值。 例子：

A
A
B
A
B
B
B
B
A

如果存在連續值（AA、AAA、AAAA.. 或 BB、BBB、BBBB...），則將第二個和對應的值替換為 C

我嘗試了以下代碼：

Dim values As Integer
values = Range().Rows.Count

For i = 1 To values
    If Range().Cells(i, 1) = Range().Cells(i + 1, 1) Then
        Range().Cells(i + 1, 1) = “C”
    End If
Next i

但是，這只考慮了 2 個連續的值，並且不超過 2.. 我該如何修復我的代碼？

感謝幫助。

謝謝

Answer 1

請嘗試下一個代碼。 在您的代碼中，第一次替換后，條件不再匹配。 代碼假定要處理的列是“A:A”：

Sub removeConsecRowsValue()
  Dim sh As Worksheet, values As Long, i As Long, j As Long
   Set sh = ActiveSheet 'use here your sheet
   values = Range("A" & Rows.count).End(xlUp).Row 'supposing that the column to be processed is A:A
    For i = 1 To values
        If sh.Range("A" & i).value = sh.Range("A" & i + 1).value Then
            Dim rng As Range
            For j = i + 1 To i + 1000
                If sh.Range("A" & j).value = sh.Range("A" & i).value Then
                    If rng Is Nothing Then
                       Set rng = sh.Range("A" & j)
                    Else
                       Set rng = Union(rng, sh.Range("A" & j))
                    End If
                Else
                    rng.Replace sh.Range("A" & i).value, "C"
                    Exit For
                End If
            Next j
        End If
    Next i
End Sub

Answer 2

替換連續

• 將完整的代碼復制到標准模塊（例如Module1 ）中。
• 僅運行Sub 。
• Function由Sub調用。
• 調整Sub中的常量。

編碼

Option Explicit

Sub ConsecutiveExample()

    Const rngAddress As String = "A1:A20"
    Const Criteria As Variant = "C"

    Dim rng As Range:Set rng = Range(rngAddress)
    Dim Target As Variant:Target = replaceConsecutive(rng, Criteria)

    If Not IsEmpty(Target) Then rng.Value = Target

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Replaces each next consecutive value in a one-column range
'               with a specified criteria and returns a 2D one-based one-column
'               array containing the modified values.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function replaceConsecutive(SourceRange As Range, ByVal Criteria As Variant, _
  Optional ByVal AnyColumn As Long = 1) As Variant

    Dim Source As Variant: Source = SourceRange.Columns(AnyColumn).Value
    If Not IsArray(Source) Then Exit Function

    Dim Target As Variant: Target = Source
    Dim i As Long

    For i = 2 To UBound(Source)
        If Source(i, 1) = Source(i - 1, 1) Then Target(i, 1) = Criteria
    Next i
    Erase Source

    replaceConsecutive = Target

End Function

Answer 3

您只需要反轉循環並按照@Gary 的學生的建議測試條件。 請參見下面的代碼。

Dim lngLastRow As Long, i As Long
lngLastRow = Range("A" & Rows.Count).End(xlUp).Row
For i = lngLastRow To 2 Step -1
    If Range("A" & i).Value = Range("A" & i - 1).Value Then Range("A" & i).Value = "C"
Next i