Bir değeri birleştirilmiş hücrede bul ve satırları silme

[pNouma]

Kıymetli Hocalarım merhaba,
Sayfada "A" sütununda birleştirilmiş hücreler bulunmakta;

bir değeri; "A" sütunundaki birleştirilmiş hücrelerde bularak , birleştirilmiş hücrede yer alan tüm satırları silecek makro kodunu nasıl yazabiliriz?

Örnek: "XXX" yazan değerini "A24:A30" birleştirilmiş hücre aralığında bulunsun, 24 ve 30 satır aralığındaki satırlar silinecek

yardımlarınız için şimdiden teşekkür eder,
iyi çalışmalar dilerim.

 

[okan32]

Deneyiniz...

Sub SatirlariSilBirlesmisHucresindekiDeger()
    Dim ws As Worksheet
    Dim rng As Range, cell As Range
    Dim arananDeger As String
    Dim silinecekSatirlar As Range
        
    Set ws = ThisWorkbook.Sheets("Sayfa1") ' Sayfanın adı
    
      arananDeger = "XXX"
    
        Set rng = ws.Range("A:A")
    
    For Each cell In rng
        If cell.MergeCells Then
            If cell.MergeArea.Cells(1, 1).Value = arananDeger Then
                               If silinecekSatirlar Is Nothing Then
                    Set silinecekSatirlar = cell.MergeArea.EntireRow
                Else
                    Set silinecekSatirlar = Union(silinecekSatirlar, cell.MergeArea.EntireRow)
                End If
            End If
        End If
    Next cell
    
    If Not silinecekSatirlar Is Nothing Then
        silinecekSatirlar.Delete
    End If

    MsgBox "İşlem tamamlandı, belirlenen satırlar silindi!"
End Sub

 

[pNouma]

Deneyiniz...

Sub SatirlariSilBirlesmisHucresindekiDeger()
    Dim ws As Worksheet
    Dim rng As Range, cell As Range
    Dim arananDeger As String
    Dim silinecekSatirlar As Range
       
    Set ws = ThisWorkbook.Sheets("Sayfa1") ' Sayfanın adı
   
      arananDeger = "XXX"
   
        Set rng = ws.Range("A:A")
   
    For Each cell In rng
        If cell.MergeCells Then
            If cell.MergeArea.Cells(1, 1).Value = arananDeger Then
                               If silinecekSatirlar Is Nothing Then
                    Set silinecekSatirlar = cell.MergeArea.EntireRow
                Else
                    Set silinecekSatirlar = Union(silinecekSatirlar, cell.MergeArea.EntireRow)
                End If
            End If
        End If
    Next cell
   
    If Not silinecekSatirlar Is Nothing Then
        silinecekSatirlar.Delete
    End If

    MsgBox "İşlem tamamlandı, belirlenen satırlar silindi!"
End Sub

Okan Hocam çok teşekkürler,