Boş Sütunları Silme

[y.selim]

Merhabalar

A ile AZ sütunları arasında sadece, hiçbir veri içermeyen boş sütunları makro ile nasıl silebilirim.

Teşekkürler, iyi çalışmalar.

 

[systran]

şu kodları module içine kopyalayıp çalıştırın.

Sub DeleteEmptyColumns()
'Updateby20140317
Dim rng As Range
Dim InputRng As Range
xTitleId = "KutoolsforExcel"
Set InputRng = Application.Selection
Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8)
Application.ScreenUpdating = False
For i = InputRng.Columns.Count To 1 Step -1
    Set rng = InputRng.Cells(1, i).EntireColumn
    If Application.WorksheetFunction.CountA(rng) = 0 Then
        rng.Delete
    End If
Next
Application.ScreenUpdating = True
End Sub

alıntı:
http://www.extendoffice.com/documents/excel/823-excel-delete-multiple-empty-columns.html

 

[y.selim]

Hocam çok teşekkür ederim zahmetleriniz için.Kodlar normal bir kitapta tam istediğim gibi çalışıyor.Fakat şöyle bir sorun var.

Bu kodları eta programından gelen bir kitapta uygulamak istiyorum ama orada çalışmıyor.Eta dan gelen bilgileri yeni bir kitaba değerleri yapıştır yapmama rağmen yine çalışmıyor.Bu sorunu nasıl çözebiliriz.

 

[systran]

örnek dosyayı yükleyiniz.

 

[y.selim]

Örnek dosya ekte

 

[systran]

boş olarak görünen sütunlarda BOŞLUK tuşu var. boş değil olarak algılanıyor, kod çalışmıyor.
sütun aralığını seçin. Değiştirden (CTRL + H)
Aranan kısmına 1 kere boşluk tuşuna basın.
Yeni değer kısmına birşey yazmayın.
Seçenekler --> Tüm hücre içeriğini eşleştir.
Tümünü değiştir.
bu işlemi yaptıktan sonra silme kodlarını deneyin.

 

[y.selim]

Hocam çok sağolun, sorun çözüldü.
Saygılar sunarım.

 

[y.selim]

Syn. systran, sabrınızı zorlamayacaksa bir ricam daha olacak.

CTRL+H yapıp boşlukları kaldırdığımızda isim-soyisim arasındaki boşlukları da kaldırıyor.Buna engel olmak için kodlara şunu ilave edebilir miyiz?

Seçilen aralıklarda öncelikle bütün boşlukları kaldırsa, sonra bütün boş sütunları silse?

 

[systran]

değiştir penceresinde şu seçeneği işaretliyor musunuz?
Seçenekler --> Tüm hücre içeriğini eşleştir.

 

[y.selim]

Merhaba,kusura bakmayın geç dönüş yapabildim.
Dediğiniz gibi "Tüm hücre içeriğini eşleştir" i seçince isimler arasında ki boşlukları kaldırmıyor.
Ama dediğim gibi bir ek kod eklenebilirse daha kullanışlı olacağı kanaatindeyim.
İlginize teşekkürler.

 

[Korhan Ayhan]

Deneyiniz.

Sub Bos_Satir_ve_Sutunlari_Sil()
    Application.ScreenUpdating = False
    
    For X = 255 To 2 Step -1
        Cells.Replace WorksheetFunction.Rept("-", X), "", xlWhole
        Cells.Replace WorksheetFunction.Rept("…", X), "", xlWhole
        Cells.Replace WorksheetFunction.Rept(".", X), "", xlWhole
        Cells.Replace "……..", "", xlWhole
    Next
    
    For X = 255 To 1 Step -1
        Cells.Replace WorksheetFunction.Rept(Chr(32), X), "", xlWhole
    Next
    
    For X = Cells(Rows.Count, 1).End(3).Row To 1 Step -1
        If Len(Cells(X, 1)) = 0 Then Rows(X).Delete
    Next
    
    For X = Cells(1, Columns.Count).End(1).Column To 1 Step -1
        Toplam = Evaluate("=SUM(LEN(" & Columns(X).Address & "))")
        If Toplam = 0 Then
            Columns(X).Delete
        End If
    Next
    
    Cells.EntireColumn.AutoFit
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[y.selim]

Korhan hocam el attığınız için teşekkürler
Biz buraya kadar olan kısmını syn systran ın yardımıyla halletmiştik

Lakin boş gözüken bazı sütunlarda bir yada birden fazla boşluk olmasından dolayı, kodlar boş gözüken sütunları silmiyor.Evvela CRTL+H ile düzeltme yapmak gerekiyor.Bunun yerine, kodlar önce kitaptaki bütün boşlukları kaldırsa ve sonrasına boş sütunları silse, bunu yapabilir miyiz?

 

[veyselemre]

Sn. y.selim, siz veri aldığınız txt dosyasını ekleyin. Ordan inceleyelim.

 

[y.selim]

Syn veyselemre 5 nolu mesajda örnek dosya var.

 

[veyselemre]

Veri aldığınız txt dosyasını demiştim excel dosyası değil.

 

[y.selim]

Veriyi ben kendim almıyorum,dışarıdan mail ile excel olarak ,eklediğim şekilde geliyor.Karşı taraf Eta dan excele aktarıyor.

 

[veyselemre]

Sub DeleteEmptyColumnsAndRows()
    Application.ScreenUpdating = False

    For Each huc In ActiveSheet.UsedRange
        huc.Value = Trim(huc.Value)
    Next huc

    For i = [IV2].End(xlToLeft).Column To 1 Step -1
        If Cells(2, i) = " " Or Cells(2, i) = Empty Then
            Columns(i).Delete
        End If
    Next

    For i = [A65536].End(3).Row To 1 Step -1
        If Cells(i, 1) Like "-*" Or Cells(i, 1) = Empty Then
            Rows(i).Delete
        End If
    Next
    Columns.EntireColumn.AutoFit
    Application.ScreenUpdating = True
End Sub

 

[Ömer BARAN]

[SIZE="2"]Sub DeleteEmptyColumnsAndRows()
    Application.ScreenUpdating = False

    For Each huc In ActiveSheet.UsedRange
        huc.Value = Trim(huc.Value)
    Next huc

    For i = [IV2].End(xlToLeft).Column To 1 Step -1
        If Cells(2, i) = " " Or Cells(2, i) = Empty Then
            Columns(i).Delete
        End If
    Next
.............
End Sub

[/SIZE]

Sayın veyselemre, verdiğiniz kod ile ilgili bir şey sormak isterim.
Tüm hücrelerdeki bir'den fazla boşlukları Trim ile tek'e indirdik.
2'nci satırda IV sütunundan başlayıp sola ilk kullanılmış hücreye gelip kullanılan son sütunu tespit ettik orası tamam.
Silme için yazdığınız For..Next döngüsündeki Step-1 kısmı next'ten sonra for satırına tekrar döndüğünde sayıyı 1 azaltmaya yarıyor anlaşılan doğru mudur acaba?
Yani buradan şunu çıkartıyorum, For a = BÜYÜK SAYI To KÜÇÜK SAYI ...Next yazdığımızda varsayılan olarak sanki devamında STEP+1 varmış gibi 1 artırıyor, Step-1 yazdığımızda ise 1 azaltmamızı sağlıyor (Step-1, For satırına BÜYÜK SAYI To KÜÇÜK SAYI yazdığımızda mutlaka kullanılması gereken bir şey demek ki).
Öğrenmek için soruyorum, doğru mudur?
Yanlışsa açıklayabilir misiniz?

 

[y.selim]

Veysel hocam emeğine ,aklına sağlık,harika olmuş.
Ekstralar için de çok teşekküler.Daha iyisi olamazdı.

 

[veyselemre]

Sayın veyselemre, verdiğiniz kod ile ilgili bir şey sormak isterim.

Merhaba Ömer Bey,

%100 Doğru anlamışsınız, step kullanılmazsa döngüde varsayılan olarak 1 er artırılır. (Step -1), (Step 5), (step -5) vs. şekillerde de artırılır veya azaltılabilir.

Yalnız trim komutu sadece önünde ve sonunda olan boşlukları atar. Aradaki boşluklara dokunmaz.