Excel 如何确定连续值的组？

我在A列中有一些数据如下

ColA
Z
A

Z
A

Z
A
A
B
B
B

Z
B
B

Z
C
C
C
D
D

我想在B列中打印

• 如果A=“Z”中的单元格为“0”

• A中的单元格为空时为空

• 例如，当一个组以字母a开头时，接下来的所有a都应标记为1

• 当下一组开始时，即用字母B，然后用2标记所有后面的B

• 当一个新组以字母C开头时，再次用值1标记，依此类推

• A列中的值不是按字母顺序排列的字母。这只是一个例子。我只知道“Z”的值，组可以有任何字符串

也就是说，为每个新组交替分配值1和2。我希望有意义

这是我当前的代码

Sub t1（）
作为对象的Dim dict
Set dict=CreateObject（“Scripting.Dictionary”）
对于i=1到24
如果单元格（i，“A”）=“Z”，则
单元格（i，“B”）=“0”
ElseIf Cells（i，“A”）“Z”和Cells（i，“A”）“那么
计数器=计数器+1
指令添加键：=单元格（i，“A”），项：=1
如果不存在dict（单元格（i，“A”）），则
如果计数器Mod 2=1，则
单元格（i，“B”）=“1”
其他的
单元格（i，“B”）=“2”
如果结束
如果结束
如果结束
下一个
端接头

B列中的当前输出和列单元格中的预期输出

ColA ColB    ColC
Z      0     0
A      1     1
           
Z      0     0
A      2     1
           
Z      0     0
A      1     1
A      2     1
B      1     2
B      2     2
B      1     2
           
Z      0     0
B      2     2
B      1     2
           
Z      0     0
C      2     1
C      1     1
C      2     1
D      1     2
D      2     2

也许有人能帮我。谢谢

试试看

Sub test()
    Dim vDB, vR()
    Dim Dict As Object
    Dim i As Long, r As Long
    Dim cnt As Integer
    
    vDB = Range("a1", Range("a" & Rows.Count).End(xlUp))
    Set Dict = CreateObject("Scripting.Dictionary")
    r = UBound(vDB, 1)
    
    ReDim vR(1 To r, 1 To 1)
    For i = 1 To r
        If vDB(i, 1) = "" Then
            cnt = 0
            Set Dict = CreateObject("Scripting.Dictionary") '
        Else
            If vDB(i, 1) Like "Z*" Then
                vR(i, 1) = 0
            Else
                If Dict.Exists(vDB(i, 1)) Then
                    vR(i, 1) = Dict(vDB(i, 1))
                Else
                    cnt = cnt + 1
                    Dict.Add vDB(i, 1), cnt
                    vR(i, 1) = Dict(vDB(i, 1))
                End If
            End If
        End If
    Next i
    Range("b1").Resize(r) = vR
End Sub

结果图像 试试看

Sub test()
    Dim vDB, vR()
    Dim Dict As Object
    Dim i As Long, r As Long
    Dim cnt As Integer
    
    vDB = Range("a1", Range("a" & Rows.Count).End(xlUp))
    Set Dict = CreateObject("Scripting.Dictionary")
    r = UBound(vDB, 1)
    
    ReDim vR(1 To r, 1 To 1)
    For i = 1 To r
        If vDB(i, 1) = "" Then
            cnt = 0
            Set Dict = CreateObject("Scripting.Dictionary") '
        Else
            If vDB(i, 1) Like "Z*" Then
                vR(i, 1) = 0
            Else
                If Dict.Exists(vDB(i, 1)) Then
                    vR(i, 1) = Dict(vDB(i, 1))
                Else
                    cnt = cnt + 1
                    Dict.Add vDB(i, 1), cnt
                    vR(i, 1) = Dict(vDB(i, 1))
                End If
            End If
        End If
    Next i
    Range("b1").Resize(r) = vR
End Sub

结果图像

试试这段代码

Sub Test()
    Dim r As Range, c As Range, s As String, n As Long, x As Long, y As Long
    With ThisWorkbook.Worksheets("Sheet1")
        .Columns(2).ClearContents
        For Each r In .Columns(1).SpecialCells(2).Areas
            n = 0: x = 0
            For Each c In r
                If c.Value = "Z" Then
                    c.Offset(, 1).Value = 0
                Else
                    If c.Value <> s And c.Address = r(2).Address Then y = 0
                    If c.Value <> c.Offset(-1).Value And c.Address = r(2).Address And s <> "" Then
                        If c.Value = s Then c.Offset(, 1).Value = y: GoTo Skipper
                    End If
                    If c.Value <> c.Offset(-1).Value Then
                        n = n + 1: c.Offset(, 1).Value = n + y
                    Else
                        c.Offset(, 1).Value = c.Offset(-1, 1).Value
                    End If
                End If
Skipper:
                x = x + 1
                If r.Cells.Count = x Then s = c.Value: y = c.Offset(, 1).Value
            Next c
        Next r
    End With
End Sub

子测试（）
尺寸r为范围，c为范围，s为字符串，n为长度，x为长度，y为长度
使用此工作簿。工作表（“表1”）
.栏目（2）.清晰内容
对于每个r In.列（1）.特殊单元（2）.区域
n=0:x=0
对于r中的每个c
如果c.Value=“Z”，则
c、 偏移量（，1）。值=0
其他的
如果c.值s和c.地址=r（2）.地址，则y=0
如果c.Value c.Offset（-1）.Value和c.Address=r（2）.Address和s“”，则
如果c.Value=s，则c.Offset（，1）.Value=y:GoTo-Skipper
如果结束
如果c.值c.偏移（-1）.值，则
n=n+1:c.偏移量（，1）。值=n+y
其他的
c、 偏移量（，1）.Value=c.Offset（-1，1）.Value
如果结束
如果结束
船长：
x=x+1
如果r.Cells.Count=x，则s=c.Value:y=c.Offset（，1）.Value
下一个c
下一个r
以
端接头

这是快照

试试这段代码

Sub Test()
    Dim r As Range, c As Range, s As String, n As Long, x As Long, y As Long
    With ThisWorkbook.Worksheets("Sheet1")
        .Columns(2).ClearContents
        For Each r In .Columns(1).SpecialCells(2).Areas
            n = 0: x = 0
            For Each c In r
                If c.Value = "Z" Then
                    c.Offset(, 1).Value = 0
                Else
                    If c.Value <> s And c.Address = r(2).Address Then y = 0
                    If c.Value <> c.Offset(-1).Value And c.Address = r(2).Address And s <> "" Then
                        If c.Value = s Then c.Offset(, 1).Value = y: GoTo Skipper
                    End If
                    If c.Value <> c.Offset(-1).Value Then
                        n = n + 1: c.Offset(, 1).Value = n + y
                    Else
                        c.Offset(, 1).Value = c.Offset(-1, 1).Value
                    End If
                End If
Skipper:
                x = x + 1
                If r.Cells.Count = x Then s = c.Value: y = c.Offset(, 1).Value
            Next c
        Next r
    End With
End Sub

子测试（）
尺寸r为范围，c为范围，s为字符串，n为长度，x为长度，y为长度
使用此工作簿。工作表（“表1”）
.栏目（2）.清晰内容
对于每个r In.列（1）.特殊单元（2）.区域
n=0:x=0
对于r中的每个c
如果c.Value=“Z”，则
c、 偏移量（，1）。值=0
其他的
如果c.值s和c.地址=r（2）.地址，则y=0
如果c.Value c.Offset（-1）.Value和c.Address=r（2）.Address和s“”，则
如果c.Value=s，则c.Offset（，1）.Value=y:GoTo-Skipper
如果结束
如果c.值c.偏移（-1）.值，则
n=n+1:c.偏移量（，1）。值=n+y
其他的
c、 偏移量（，1）.Value=c.Offset（-1，1）.Value
如果结束
如果结束
船长：
x=x+1
如果r.Cells.Count=x，则s=c.Value:y=c.Offset（，1）.Value
下一个c
下一个r
以
端接头

这是快照

您好，没有。假设Z和空值不存在。然后我们有这个输入A，A，A，B，C，C，C，D，D，A，E，E，E，E，B，A。我只想要每个新组的1和2之间的交替。不管A以前是否出现过，都应该被视为新组。使用此输入，输出应为9小时前的1,1,1,2,1,1,2,1,2,2,2,1,2–Ger Cas

试试这个疯狂的公式（我相信这可以变得更简单）。将其放入单元格

B2

，如下面的屏幕截图所示

（2）如果，如果，如果，如果，如果（2）0，如果（A2=A1，B1，如果（或者（A1=“Z）是空白（A1）如果，如果，如果，如果（如果）如果）如果，如果，如果，如果（如果）如果，如果）如果（2）2=A1，如果，如果，如果，如果，如果，如果，如果，如果（如果）如果，如果，如果，如果，如果，如果，如果，如果，如果，如果，如果（如果）如果，如果，如果，如果，如果，如果，如果，如果，如果，如果（如果）如果（如果）是是（或（或（或）是）是）或（或（或（或（或）是）是）或（或（或（或（或）是）是）如果）如果（或（或（或（或（或）如果）如果）如果）如果）如果）如果（2）如果（2）（2）（2）（2）（2）（2）（2）（2）（2）（2）（2）（2）（2）（2）（2）（如果（B1=1,2，如果（B1=2,1，“”）））

假设您的数据如下所示

ColA
Z
A

Z
A

Z
A
A
B
B
B

Z
B
B

Z
C
C
C
D
D

解释

按照以下顺序进行一系列检查

ISBLANK（A2）：检查单元格是否为空。如果为空，则保持输出为空

A2=“Z”：检查单元格是否有“Z”。输出

0

A2A1：检查A列中的值是否更改。如果未更改，则从顶部拾取值。如果更改，请参阅下一步检查

然后我们使用

INDEX

和

AGGREGATE（）

进行反向匹配，以查找值的出现情况，如果找到匹配项，则从列

B

您好，不。假设Z和空值不存在。然后我们有这个输入A，A，A，B，C，C，C，D，D，A，E，E，B，A。我只希望每个新组在1和2之间交替。不管A以前是否出现过，都应该作为新组。有了这个输入，输出应该是1，1，1，2，1，1，2，1，2–9小时前

试试这个疯狂的公式（我相信这可以变得更简单）。把它放在单元格

B2

中，如下面的屏幕截图所示

=IF（ISBLANK（A2），“”，IF（A2=“Z”，0，IF（A2=A1，B1，IF（或（A1=“Z”，ISBLANK（A1）），IF（iError）索引（$A$1:$A1，聚合（14,6，行（$A$1:1）/（$A$1: