Bitişik hücrelere dayalı Excel Otomatik Artışı

Question

"A" sütunundaki tüm hücreleri otomatik olarak tek bir ondalık basamakta numaralandıracak bir VBA makrosu oluşturmak istiyorum. 'B' sütununda bir değere sahip olmayan bir satır olduğunda, 'A' sütunu, bir sonraki tamsayıda numaralandırmayı yeniden başlatmalıdır.

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

bu yeterince açıklayıcı olduğunu düşünüyorum ama hiçbir şey seni karıştırır eğer post up: Ben .Areas kullanarak gibi

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

İşte

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