• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

sheet silme

zulfuernek

Altın Üye
Katılım
24 Haziran 2017
Mesajlar
761
Excel Vers. ve Dili
türkçe
Application.DisplayAlerts = False
For i = Sheets.Count To 1 Step -1
If IsNumeric(Sheets(i).Name) Then Sheets(i).Delete
Next

yukarıdaki kodla excel kitabında bulunan ve sheet isminde rakam olan sayfaları silebiliyorum.

ancak istediğim şu. rakam içeren tüm sheetleri silmektense textboxa yazdığım rakamları içeren sheetleri silsin.

mesela 12.01.2017 ve 11.03.2018 tarihli sheetler var ve bu kod bütün sheetleri siliyor. benim amacım textbox1 e yazdığım rakamlı olanı silsin. mesela 2017 yazınca sadece 2017 leri silsin.
 
Silinecek sayfa adı TextBox'a tam olarak aynı yazılacaksa aşağıdaki gibi olabilir.
.
Kod:
[B]Private Sub CommandButton1_Click()[/B]
On Error Resume Next
Application.DisplayAlerts = False
    Sheets([B][COLOR="Red"]TextBox1.Text[/COLOR][/B]).Delete
Application.DisplayAlerts = True
[B]End Sub[/B]
 
ömer hocam bu formül ayrı bitr buton işimi görür. fakat tek tek sayfaları silmeye yarıyacaktır.
benim istediğim ise textboxa 2017 yazdığım zaman 2017 yılına ait sheetlerde 2017 yazan tüm shhetleri silmesi.
 
Kod:
Private Sub CommandButton1_Click()
On Error Resume Next
Application.DisplayAlerts = False
For Each sayfa In Worksheets
    
    sayfaadi = InStr(1, sayfa.Name, "2017")
    If sayfaadi > 0 Then
        Sheets(sayfa.Name).Delete
    End If
Next
Application.DisplayAlerts = True
MsgBox "Sayfalar silindi...", vbInformation, "ASKM"
End Sub
 
Aşağıdaki kod ile de size içerecek kelimeyi sorup siliyor.
Kod:
Private Sub CommandButton1_Click()
On Error Resume Next
Application.DisplayAlerts = False
SilinecekSayfa = Application.InputBox("Lütfen silinmesini istediğiniz sayfa adını yazın...", "Sayfa ismi - ASKM")
For Each sayfa In Worksheets
    
    sayfaadi = InStr(1, sayfa.Name, SilinecekSayfa)
    If sayfaadi > 0 Then
        SilinenSayfaSayisi = SilinenSayfaSayisi + 1
        Sheets(sayfa.Name).Delete
    End If
Next
Application.DisplayAlerts = True
If SilinenSayfaSayisi > 0 Then
    MsgBox SilinenSayfaSayisi & " adet " & SilinecekSayfa & " içeren sayfa silindi...", vbInformation, "ASKM"
Else
    MsgBox SilinecekSayfa & " kelimesini içeren sayfa bulunamadı...", vbInformation, "ASKM"
End If
End Sub
 
askm hocam çok harika olmuş gerçekten tam istediğim gii hatta istediğimden ötesi ben textboxla silmeyi düşünüyordum siz msg boxla sildirmişsiniz. harika olmuş
 
Rica ederim. İyi çalışmalar.
 
Sayın askm,
bu çalışma benzeri bir çalışma olarak mesela sayfa ismi içeriğinde "ceviz" kelimesi geçen sayfa sayısını A1'e, "elma" kelimesi geçen sayfa sayısını A2'ye yazdırmak için ne yapmak gerekir acaba?
Teşekkürler.
 
Aşağıdaki şekilde yazabilirsiniz.Çizgi içerisindeki alanı çoğaltarak istediğiniz sayfa sayılarını alabilirsiniz.
Kod:
Private Sub CommandButton1_Click()
On Error Resume Next
Application.DisplayAlerts = False
For Each sayfa In Worksheets

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''    
    sayfaadi = InStr(1, sayfa.Name, "Ceviz")
    If sayfaadi > 0 Then
        Ceviz = Ceviz + 1
    End If
Next
ActiveCell = Ceviz 'Bulunduğunuz satıra yazar.
'Sabit bir sayfanın A1 hücresine yazması için aşağıdaki kodu kullanın
'Sheets("Sayfa6").Range("A1") = ceviz 'Baştaki tek tırnağı kaldırın.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Application.DisplayAlerts = True
MsgBox Ceviz & " adet Sayfası vardır ...", vbInformation, "ASKM"
End Sub
 
farklı bi koda daha ihtiyacım var.
elimde ayın her günü için bir sheet olan çalışma kitabım var.
userform açılınca o günün tarihine ait sayfa açmak için buton ekledim ve butona tıklayınca o günün tarihiyle bir sheet açıyor.
gerekli olan şu. mesela 8.ayın 10 undan sonrasına ait bir dosya açılırsa 7. aya ait tüm sheetleri silsin. 9.ayın 10 umdan sonrasına ait shhet açılırsa 8. aya ait sheetleri silsin. her ay bu döngüyü sağlamalı.
saygılarımla
 
Örnek dosyanızı eklerseniz dilediğiniz işlemi yaptırmaya çalışalım.
 
aslında eksik söyledim askn hocam. bir önceki aya ait sheeti değilde mesela 10. ayın 10 undan sonra dosya varsa geçmiş aylara ait tüm shhetleri diyeyim 9. ay ve daha eski aylara ait. örnek dosyayıda akşam buraya ekleyeceğim. iş yerinde olduğum için yükleme sitelerini açamıyorum
 
Mantık olarak izah edeyim.
Eğer ayın tüm günlerine 01.08.2017, 02.08.2017 şeklinde tarih girerek sayfa oluşturuyorsanız 7 ay ve önceki ayların sayfalarını direkt kodla silebiliriz.
Eğer 1 ağustos, 2 ağustos gibi ay ismi kullanıyorsanız o zaman yardımcı sayfa ya da sütun kullanmak gerekebilir. Bu yüzden örnek dosyanız olursa daha net çözüm alabiliriz.

Not: Ekleyeceğiniz belge asıl dosyanız ise ya da herkesle paylaşmak istemediğiniz bilgiler mevcutsa özelden yazabilir ya da "askmadige34 hotmail" adresine mail atabilirsiniz.
 
size mail olarak göndereceğim askm hocam. ay rakam olarak giriliyor. 01.07.2017 gibi
 
Merhaba.

Belgenizdeki GİRİŞ adlı küçük UserFormun CommandButton3 (GÜN OLUŞTUR) düğmesinin kodlarında,
aşağıdaki kırmızı satırların arasına mavi olanları ekleyerek dener misiniz?
►►Kod'da kriter olan 10 gün farkını değiştirerek geriye doğru kaç günlük sayfayı tutup diğerlerini sileceğinizi belirleyebilirsiniz.
Gerçi fark gün sayısını belirledikten sonra, mevcut sayfanın günü kontrol etmeye gerek olmayacaktır.
Duruma göre tekrar değişiklik yapılabilir.

NOT: Siyah renklendirdiğim MsgBox satırı adı kontrol edilen sayfa ve gün farkını görmeniz içindir.
Yapılan işlemin doğruluğundan emin olunca MsgBox satırını silin.
.
Kod:
[COLOR="Red"]        Sheets("ŞABLON").Copy After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = TextBox1.Text[/COLOR]
        
        
[COLOR="Blue"]Dim tarih, starih As Date
Dim s, gun, fark As Integer
    tarih = DateSerial(Right(TextBox1.Text, 4), Mid(TextBox1.Text, 4, 2), Left(TextBox1.Text, 2))
        For s = Sheets.Count To 1 Step -1
            Application.DisplayAlerts = False
            On Error Resume Next
                If IsNumeric(Left(Sheets(s).Name, 2)) And Len(Sheets(s).Name) = 10 Then
                    starih = DateSerial(Right(Sheets(s).Name, 4), Mid(Sheets(s).Name, 4, 2), Left(Sheets(s).Name, 2))
                    fark = tarih - starih
                    gun = Day(CDate(TextBox1.Text))
[B][COLOR="Black"]                    MsgBox "Adına Bakılan TARİH: " & Sheets(s).Name & "  GÜN: " & gun & "   / FARK: " & fark[/COLOR][/B]
                        If [B][SIZE="4"]fark > 10[/SIZE][/B] And gun > 10 Then
                            Sheets(s).Delete
                        End If
                        fark = 0: gun = 0
                End If
            Application.DisplayAlerts = True
        Next[/COLOR]
        
        
[COLOR="Red"]    Else
        MsgBox TextBox1.Text & " isimli sayfa daha önce eklenmiş!", vbCritical[/COLOR]
 
Ayrıca amacınız sayfaları silmekten ziyade ANAKASA formundaki gün seçimi yapılan Combobox'ta açılan listenin uzamasını engellemek ise;
son tarihten geriye doğru belli (istediğiniz) sayıda tarihin görüntülenmesi de sağlanabilir.

Bence SİLMEK yerine az tarih GÖRÜNTÜLEMEyi tercih etmelisiniz.
.
 
sayın ömer hocam verdiğiniz kod gayet güzel çalışıyor ancak ufak bir sorun va. bildiğiniz üzere sistem dosyalarımıda siliyor. yani sadece numeric olanları silmesiiçin ne yapmamız gerekli
 
ömer bey kodu şimdi inceledim ve uyguladım. shhetlerin isimlerini gösterifoyr farklarını gösteriyor ancak 10 günden eski olanları silmiyor. sadece msgboxta günsay yapıyor.
 
Geri
Üst