ExcelVBA.Net sitesine katkıda bulunabilirsiniz

[vuranoglu]

İyi akşamlar
Arkadaşlar vermiş olduğunuz bilgiler doğrultusunda da sonuç alınmadı?

[halily]

.Sheets("1").Range("a:J") = "" gibi kodları aşağıdaki gibi düzenleyip dener misiniz

Kod: Tümünü seç

.Sheets("1").Range("a:J").ClearContents

[feraz]

İyi akşamlar
Arkadaşlar vermiş olduğunuz bilgiler doğrultusunda da sonuç alınmadı?

İyi akşamlar.Tam olarak ne istiyorsunuz?
Temizleme kodları zten sizinki.Halil hocamızın kodu ise dediğniz excelleri açıp 1 den 7 ye kadar olan sayfaları temizliyor.

[vuranoglu]

İyi akşamlar.
Çalışmalar ekteki gibi sonuç vermektedir.
Pc bağlanmak istiyorsanız.
Ammyy proğramı var kullanan varsa beraber görelim.

[vuranoglu]

Arkadaşlar
Emeklerinize sağlık silme alanlarında değişiklikler yaptım şu anda dene 2 sayfada sonuç alındı.
Tekrar emeği geçen değerli zamanlarını paylaşan arkadaşlara teşekkürler.
İyi akşamlar

[halily]

aşağıdaki gifte de görebileceğiniz gibi kod temizliyor
birkaç defa denedim

Kod: Tümünü seç

Sub ExcelBos()
Dim DosyaAdi As String
Dim Klasor As String
Klasor = ThisWorkbook.Path & "\OCAK 2021\"
DosyaAdi = Dir(Klasor & "*.xls?")
Application.ScreenUpdating = False
Do While DosyaAdi <> ""
Debug.Print DosyaAdi, Klasor & DosyaAdi
Dim wb As Workbook
    Set wb = Workbooks.Open(Klasor & DosyaAdi)  'Workbooks.Open(Klasor & DosyaAdi)
With wb
.Sheets("1").Range("a:J").ClearContents
.Sheets("2").Range("C3:O156").ClearContents
.Sheets("3").Range("C1:AL5000").ClearContents
.Sheets("4").Range("A:AK").ClearContents
.Sheets("5").Range("A1:AK5000").ClearContents
.Sheets("6").Range("A1:AK5000").ClearContents
.Sheets("7").Range("A1:AD5000").ClearContents
.Close savechanges:=True
End With

    DosyaAdi = Dir()
Loop
Application.ScreenUpdating = True
MsgBox ""
End Sub

[vuranoglu]

Tekrar merhaba
Dosya adı degiştiğinde makroya girmeden nasıl değiştirebiliriz.
OCAK 2021/ ŞUBAT 2021/MART 2021/NİSAN2021.......ARALIK 2021 GİBİ

[halily]

Klasor = ThisWorkbook.Path & "\OCAK 2021\" klasör adresi buradan alınıyor
Burada yapacağınız değişiklikle istediğiniz klasörü seçebilirsiniz

[vuranoglu]

Merhaba
Çalışma sayfaları içerisine satır sütunlar var. Buralarda hata veriyor.

[feraz]

Tekrar merhaba
Dosya adı degiştiğinde makroya girmeden nasıl değiştirebiliriz.
OCAK 2021/ ŞUBAT 2021/MART 2021/NİSAN2021.......ARALIK 2021 GİBİ

Alttaki kod tüm klasörlerlerdeki excelleri siler.Klasöre şubat,mart gibi ekleyip deneyiniz.

Kod: Tümünü seç

Sub Bosalt()
    Call excelSil(ThisWorkbook.Path)
    MsgBox "Bitti..", vbInformation, "Bitti"
End Sub

Sub excelSil(StartFolderpath As String)

    Dim fil As Object
    Dim klasor As Object
    Dim Altklasor As Object
    Dim wb As Workbook, kitapAd As String
   
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set klasor = fso.GetFolder(StartFolderpath)
   
    Application.ScreenUpdating = False
    For Each fil In klasor.Files
        If Left(LCase(fso.GetExtensionName(fil.Path)), 2) = "xl" And fil.Path <> ThisWorkbook.FullName And Left(fil.Name, 2) <> "~$" Then
            Set wb = Workbooks.Open(fil.Path)
            With wb
                kitapAd = wb.Name
                If Sayfaad("1", kitapAd) = True Then .Sheets("1").Range("C3:O156") = ""
                If Sayfaad("2", kitapAd) = True Then .Sheets("2").Range("C3:O156") = ""
                If Sayfaad("3", kitapAd) = True Then .Sheets("3").Range("C1:AL5000") = ""
                If Sayfaad("4", kitapAd) = True Then .Sheets("4").Range("A:AK") = ""
                If Sayfaad("5", kitapAd) = True Then .Sheets("5").Range("A1:AK5000") = ""
                If Sayfaad("6", kitapAd) = True Then .Sheets("6").Range("A1:AK5000") = ""
                If Sayfaad("7", kitapAd) = True Then .Sheets("7").Range("A1:AD5000") = ""
                wb.Close True
                Set wb = Nothing
            End With
        End If
    Next
        For Each Altklasor In klasor.SubFolders
            Call excelSil(Altklasor.Path)
        Next
    Application.ScreenUpdating = True
    Set klasor = Nothing: Set Altklasor = Nothing: Set fil = Nothing:  Set fso = Nothing
End Sub

Function Sayfaad(syfad As String, wb1 As String) As Boolean
    Dim ws As Worksheet, wb As Workbook
    Sayfaad = False
    On Error Resume Next
    Set wb = Workbooks(wb1)
    Set ws = wb.Worksheets(syfad)
    If Not ws Is Nothing Then Sayfaad = True
    Set wb = Nothing: Set ws = Nothing
End Function

[vuranoglu]

İyi akşamlar
Çalışma sayfalarında bazı satır ve sütunlar birleştirilmiş halde kod çalıştırınca hata veriyor.
Bir üstteki cevapta ekran görüntüsü var.

[halily]

Peki hücreleri çözmenin bir sakıncası var mı?
Silmeden önce hücreler çözülebilir
Ama denemelerimde farklı satır ve sütunlardaki hücreleri birleştirip kodu denedim sorun çıkarmadı
Sorun çıkaran dosyayı ekleyin
Hangi sayfada sorun çıkarıyor hangi hücreler bitişik onu belirtin çözmeye çalışalım

[feraz]

İyi akşamlar
Çalışma sayfalarında bazı satır ve sütunlar birleştirilmiş halde kod çalıştırınca hata veriyor.
Bir üstteki cevapta ekran görüntüsü var.

İyi akşamlar.Silme kodları sizin zaten.Hatalı şekilde eklerseniz yardımcı olunabilir.

[vuranoglu]

Merhaba
1 ve 2 nolu sayfalarda birleştirilmiş satırlar var bunlar veri aldığımız dosyadan geliyor. Sayfa formatları ektedki gibi.
Temizleme esnasında hücreler çözülebilirse o da olabilir.
Emeğiniz için teşekkür ederim

[feraz]

Meraktan soruyorum neden dosyanızda silme kodu olan dosyası olan dosya yok?

[vuranoglu]

Kusura bakma feraz bey aynı anda birçok şeyle uğraşınca silme kodunu eklememişim tekrar göndereyim.

[feraz]

Gif hazırladım birleştirilmiş hücrelerde siliniyor verdiğimiz kodlarla.
Kolay gelsim abey,benden bu kadar.

[halily]

Kod: Tümünü seç

.Sheets("1").Range("a:J").UnMerge

tüm sayfalar için bunun gibi çözme kodu ekleyebilirsiniz

[vuranoglu]

İyi akşamlar
Sayın feraz,kanakan52,halily
Yardımlarınız için teşekkür ederim.

[halily]

rica ederim
iyi çalışmalar