Excel自动增量基于相邻单元格

Question

我想创建一个VBA宏，它会自动将列'A'中的所有单元格编号为单个小数位，当且仅当它们在列'B'中有值时。每次在“B”列中都有一行没有值时，“A”列应该在下一个整数处重新开始编号。

IE：

|COLUMN A | COLUMN B|
|:-------:|:-------:|
|  1.1    |  TEXT   |
|  1.2    |  TEXT   |
|  1.3    |  TEXT   |
|  1.4    |  TEXT   |
|  1.5    |  TEXT   |
|         | *NO TEXT* |
|  2.1    |  TEXT   |
|  2.2    |  TEXT   |
|  2.3    |  TEXT   |
|         | *NO TEXT* |
|  3.1    |  TEXT   |
|  3.2    |  TEXT   |
|  3.3    |  TEXT   |
|  3.4    |  TEXT   |

Answer 1

我认为这是非常不言自明的，但如果有什么事情让你感到困惑，那就张贴：

Option Explicit

Private Sub numberCells()

    Dim totalRows As Long
    Dim i As Long
    Dim baseNumber As Long
    Dim count As Integer

    totalRows = ActiveSheet.UsedRange.Rows.count

    baseNumber = 1
    i = 2

    Do While i <= totalRows

        If Range("B" & i).Value <> "" Then

            count = count + 1
            Range("A" & i).Value = baseNumber & "." & count

        Else

            baseNumber = baseNumber + 1
            count = 0

        End If

        i = i + 1

    Loop

End Sub

Answer 2

我喜欢使用.Areas，

这是我的版本

Sub Do_It_Good()
    Dim RangeArea As Range, c As Range, LstRw As Long, sh As Worksheet, Rng As Range


    Set sh = Sheets("Sheet1")
    With sh
        LstRw = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
        Set Rng = .Range("B2:B" & LstRw)

        y = 0

        For Each RangeArea In Rng.SpecialCells(xlCellTypeConstants, 23).Areas
            y = y + 1
            x = 0

            For Each c In RangeArea.Cells
                c.Offset(, -1) = y & "." & 1 + x
                x = x + 1
            Next c

        Next RangeArea
    End With

End Sub