Hücre içindeki metne göre Sütun silmek

hadromer

Altın Üye
Katılım
23 Ekim 2015
Mesajlar
402
Excel Vers. ve Dili
LTSC Professional Plus 2021 64 Bit Türkçe
Altın Üyelik Bitiş Tarihi
26-04-2028
Merhaba,
fotoğrafta görüldüğü halde verilerim var. Ben burada Lower ve Upper yazan sütunları tamamen silmek istiyorum. Yan yana veri çok olunca tek tek sağtıkla sil yapmak zor oluyor. Yardımcı olabilir misiniz, teşekkür ederim 220607
 

Ekli dosyalar

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Merhaba,

Deneyiniz.
Kod:
Sub Sil()

    Dim aranan, j As Byte, c As Range, Adr As String, d As Range
    
    aranan = Array("Lower", "Upper")

    For j = 0 To UBound(aranan)
        Set c = Rows(1).Find(aranan(j), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                If d Is Nothing Then
                    Set d = Columns(c.Column)
                Else
                    Set d = Application.Union(d, Columns(c.Column))
                End If
                Set c = Rows(1).FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    Next j
  
    Application.ScreenUpdating = False
    If Not d Is Nothing Then d.Delete
    
End Sub
 

hadromer

Altın Üye
Katılım
23 Ekim 2015
Mesajlar
402
Excel Vers. ve Dili
LTSC Professional Plus 2021 64 Bit Türkçe
Altın Üyelik Bitiş Tarihi
26-04-2028
Merhaba,

Deneyiniz.
Kod:
Sub Sil()

    Dim aranan, j As Byte, c As Range, Adr As String, d As Range
   
    aranan = Array("Lower", "Upper")

    For j = 0 To UBound(aranan)
        Set c = Rows(1).Find(aranan(j), , xlValues, xlWhole)
        If Not c Is Nothing Then
            Adr = c.Address
            Do
                If d Is Nothing Then
                    Set d = Columns(c.Column)
                Else
                    Set d = Application.Union(d, Columns(c.Column))
                End If
                Set c = Rows(1).FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Adr
        End If
    Next j
 
    Application.ScreenUpdating = False
    If Not d Is Nothing Then d.Delete
   
End Sub
çok teşekkür ederim :)
 
Üst