Aralıktaki İlk dolu ve Son dolu hücre?

[hsayar]

Sub Aralıktaki_ilk_dolu_satırlar()
Application.ScreenUpdating = False
  Dim csfRpr As Worksheet: Set csfRpr = ThisWorkbook.Worksheets("Rapor")
  Dim rngBul As Range
  With csfRpr
    .Columns("G").Clear
    For Each rngBul In .Range("A2:E500").SpecialCells(xlCellTypeConstants, 23).Areas
      Cells(rngBul.Row, "g") = rngBul.Row & ". satır ilk dolu satırdır."
      'Cells([COLOR=Red]AralıktakiSonSat[/COLOR].Row, "g") = [COLOR=Red]AralıktakiSonSat[/COLOR].Row & ". satır son dolu satırdır."
    Next rngBul
    Set rngBul = Nothing
  End With
  Set csfRpr = Nothing
Application.ScreenUpdating = True
End Sub

Yukarıdaki kodlar ile çalışınca birer boşluk ile gruplanmış hücreler yarılarak aşağıdak resim görüntüsü meydan geliyor.

 

[Levent Menteşoğlu]

Aşağıdaki gibi deneyin.

Sub Aralıktaki_ilk_dolu_satırlar()
Application.ScreenUpdating = False
  Dim csfRpr As Worksheet: Set csfRpr = ThisWorkbook.Worksheets("Rapor")
  Dim rngBul As Range
  With csfRpr
    .Columns("G").Clear
  Set rngBul = .Range("A2:E500")
  ilksatir = rngBul.SpecialCells(xlCellTypeConstants, 23).Cells(1).Row
  sonsatir = rngBul.SpecialCells(xlCellTypeLastCell).Row
  Cells(ilksatir, "g") = ilksatir & ". satır ilk dolu satırdır."
  Cells(sonsatir, "g") = sonsatir & ". satır son dolu satırdır."
  Set rngBul = Nothing
  End With
  Set csfRpr = Nothing
Application.ScreenUpdating = True
End Sub

 

[hsayar]

hocam teşekkür ederim.
Sabahleyin http://www.excel.web.tr/showthread.php?t=58449 linkindeki soruyu cevaplamak için sormuştum aklıma aşağıdaki yöntem geldi daha sonra. Ancak sayenizde yeni şeyler öğreniyorum.

17.mesajdan bir pasaj....

    For Each rngAra In .Range("A2:E500").SpecialCells(xlCellTypeConstants, 23).Areas
      'MsgBox UBound(rngAra.Value, 1) & " * " & UBound(rngAra.Value, 2)
      arasonsat = rngAra.Row + [B][COLOR=DarkGreen]UBound(rngAra.Value, 1)[/COLOR][/B] - 1
      For i = rngAra.Row + 1 To arasonsat