GİZLİ SÜTUNLARI SİL

[meslek5]

Merhaba, çalışma sayfasındaki verilerin anlık değerlerine göre gizlenen yada tekrar açılan sütunlar bulunmaktadır. Userform üzerindeki bir buton ile Gizli sütunları silmek istiyorum. yardımlarınız için şimdiden teşekkür ederim.

Not: tabloda birleştirilmiş başlık (sütun) bulunmaktadır.

 

[ÖmerFaruk]

Deneyin.

Sub sil()
    For i = 1 To Range("A1").SpecialCells(xlLastCell).Column
        If Columns(i).Hidden Then
                Columns(i).Delete
                i = i - 1
        End If
    Next i
End Sub

 

[meslek5]

Deneyin.

Sub sil()
    For i = 1 To Range("A1").SpecialCells(xlLastCell).Column
        If Columns(i).Hidden Then
                Columns(i).Delete
                i = i - 1
        End If
    Next i
End Sub

maalesef sonsuz döngüye girdi. hata verdi

 

[ÖmerFaruk]

Mevcut kodlarınızda Change gibi bir olay varsa o sebep oluyordur.
Ben deniyorum, birleşmiş bir hücresi varsa dahi gizli sütunları siliyor.

 

[meslek5]

Hocam sanırım userformda çalışan diğer kodlar buna mani oluyor. Peki sizden şunu rica edebilir miyim; masaüstünde DATA.xlsb adlı kapalı bir excel dosyasını açıp o dosyadaki gizli sütunları silebilecek bir kod verebilirmisiniz.

 

[Korhan Ayhan]

Deneyiniz.

Dosya yolunu ve kontrol edilecek sütun aralığını kendinize göre düzenlersiniz.

Option Explicit

Sub Gizli_Sutunlari_Sil()
    Dim Yol As String, Dosya As Object, Sayfa As Object, Veri As Range, Sutun As Range
   
    Application.ScreenUpdating = 0
   
    Yol = "C:\Users\Desktop\DATA.xlsb"
    Set Dosya = Workbooks.Open(Yol, False, False)
    Set Sayfa = Dosya.Sheets(1)
   
    For Each Veri In Sayfa.Range("A1:Z1")
        If Veri.EntireColumn.Hidden Then
            If Sutun Is Nothing Then
                Set Sutun = Veri.EntireColumn
            Else
                Set Sutun = Union(Sutun, Veri.EntireColumn)
            End If
        End If
    Next
   
    If Not Sutun Is Nothing Then
        Sutun.Delete
        Dosya.Close 1
        Application.ScreenUpdating = 1
        MsgBox "Gizli sütunlar silinmiştir."
    Else
        Dosya.Close 1
        Application.ScreenUpdating = 1
        MsgBox "Gizli sütun bulunamadı!", vbCritical
    End If
   
    Set Sayfa = Nothing
    Set Dosya = Nothing
End Sub