Bütün sayfalara erişim nasıl yapılır.

[s.savas]

Merhaba arkadaşlar.
İçerisinde 10 adet sayfa bulunduğu farzedilen bir çalışma kitabında yapılan bir işlemin bütün sayfalara uygulanmasını nasıl yaparız.

Örnek:
Bütün sayfaların A2 hücresine Merhaba yazdıralım veya bütün sayfaların B2 hücresini silelim.

 

[isteobenim]

Merhaba,

Bu tür işlemleri ben değişiklik yapacağım sayfaları mouse ile seçerek bir sayfada yapıyorum.
Diğerleride aynı şekilde değişiyor.
Makro ile de çözümleri vardır mutlaka.

 

[peleryn]

Sub degistir()
For i=1 To Sheets.Count
Sheets(i).Range("a2").Value="Merhaba"
Sheets(i).Range("b2").Value=""
Next
msgbox "İşlem Tamam"
End Sub

Yukardaki kodu bir modüle kopyalayıp çalıştırın

 

[s.savas]

Arkadaşım teşekkür ederim. Sanırım sorumu eksik sordum.
Çalışma belgemde 25 adet sayfa var. Bunlardan Ocak, Şubat,Mart,Nisan,Mayıs,Haziran,Temmuz,Ağustos,Eylül,Ekim,Kasım ve Aralık ismindeki sayfaların A5:BZ sütunları arasındaki verileri silmem lazım.

 

[peleryn]

Aşağıdaki şekilde bir deneyin.Aslında sayfa adlarını array olarak tanımlamak mümkündür ama daha önce hiç yapmadım.Onu da daha sonra araştırırız

Sub degistir()
For i = 1 To Sheets.Count
a = Sheets(i).Name
If a = "OCAK" Or _
a = "ŞUBAT" Or _
a = "MART" Or _
a = "NİSAN" Or _
a = "MAYIS" Or _
a = "HAZİRAN" Or _
a = "TEMMUZ" Or _
a = "AĞUSTOS" Or _
a = "EYLÜL" Or _
a = "EKİM" Or _
a = "KASIM" Or _
a = "ARALIK" Then
Sheets(i).Range("a5:bz65536").ClearContents
End If
Next
MsgBox "İşlem Tamam"
End Sub

 

[s.savas]

Aşağıdaki şekilde bir deneyin.Aslında sayfa adlarını array olarak tanımlamak mümkündür ama daha önce hiç yapmadım.Onu da daha sonra araştırırız

Teşekkür ederim arkadaşım, çözüm yönteminiz istenileni yerine getiriyor.

 

[mancubus]

Aşağıdaki şekilde bir deneyin.Aslında sayfa adlarını array olarak tanımlamak mümkündür ama daha önce hiç yapmadım.Onu da daha sonra araştırırız

bende var. kolaylık olsun.

Sub sayfaadinagoresil()

Dim sht As Worksheet
Dim dizi() As Variant
Dim eleman As String

dizi = Array("OCAK", "ŞUBAT", "MART", "NİSAN", "MAYIS", "HAZİRAN", "TEMMUZ", "AĞUSTOS", _
    "EYLÜL", "EKİM", "KASIM", "ARALIK")

For Each sht In Worksheets
    eleman = sht.Name
    If InStr(Join(dizi), eleman) > 0 Then
        sht.Range("A1:E5").ClearContents
    End If
Next
    
End Sub

 

[s.savas]

bende var. kolaylık olsun.

Sub sayfaadinagoresil()

Dim sht As Worksheet
Dim dizi() As Variant
Dim eleman As String

dizi = Array("OCAK", "ŞUBAT", "MART", "NİSAN", "MAYIS", "HAZİRAN", "TEMMUZ", "AĞUSTOS", _
    "EYLÜL", "EKİM", "KASIM", "ARALIK")

For Each sht In Worksheets
    eleman = sht.Name
    If InStr(Join(dizi), eleman) > 0 Then
        sht.Range("A1:E5").ClearContents
    End If
Next
    
End Sub

Teşekkür ederim arkadaşım çok makbule geçti.

 

[s.savas]

Algoritmayı değiştirelim arkadaşlar.

Merhaba arkadaşlar.
Aşağıdaki kodun algoritması şöyle;
1-) Zaman kontrölü yap. (Tarih 31 Aralıktan önce ise yeni dönem açmayı engelle)
2-) Kullanıcıdan onay al.
3-) Tanımlanan dizideki verileri sil.
4-) Dosyaya yeni isim vererek dosyayı farklı kaydet.

Private Sub cmdDÖNEM_Click()
Dim saat1 As Date
Dim saat2 As Date
Dim su
saat1 = DateSerial(Year(Date), 12, 31)
saat2 = Date
If saat2 < saat1 Then
su = MsgBox("31 Aralık'tan  Önce Yeni Dönem Oluşturamazsınız.", vbInformation + vbOKOnly, "SÜRE BİLDİRİMİ * Süleyman Savaş *")
End If
Exit Sub

If MsgBox("Yeni Dönem Oluşturulurken Bütün İstatistiki Veriler Silinecektir. Onaylıyorsanız Evet'i tıklatın !!" _
, vbInformation + vbYesNo, "..::DİKKAT::..") = vbNo Then Exit Sub

Dim sht As Worksheet
Dim dizi() As Variant
Dim eleman As String

dizi = Array("Ocak", "Şubat", "Mart", "Nisan", "Mayıs", "Haziran", "Temmuz", "Ağustos", _
"Eylül", "Ekim", "Kasım", "Aralık")

For Each sht In Worksheets
eleman = sht.Name
If InStr(Join(dizi), eleman) > 0 Then
sht.Range("A5:BZ65536").ClearContents
End If
Next
MsgBox "Bütün İstatistiki Veriler Silindi, Yeni Dönem Oluşturulacak.."

AD = Mid(ThisWorkbook.Name, 1, Len(ThisWorkbook.Name) - 4)
deger = InputBox("UYARI!" & Chr(10) & _
Chr(10) & "  Yeni Dosyanın adını yazınız " & Chr(10) & Chr(10) & _
"", _
"DİKKAT !", AD, , , "DEMO.HLP", 10)
Dim DosyaSistemi
Set DosyaSistemi = CreateObject("Scripting.FileSystemObject")
Dosya = ThisWorkbook.FullName
kayıt_yeri = Mid(Dosya, 1, Len(Dosya) - Len(ThisWorkbook.Name)) & deger & ".xls"
On Error Resume Next
If deger <> "" Then
DosyaSistemi.CopyFile Dosya, kayıt_yeri
Else
MsgBox "Dosya Adı Yazılı Değil Veya İptal Ettiniz"
End If
End Sub

Bu algoritmayı şu şekilde değiştirelim.
1-) Zaman kontrölü yap. (Tarih 31 Aralıktan önce ise yeni dönem açmayı engelle)
2-) Dosyaya yeni isim vererek dosyayı farklı kaydet.
3-) Mevcut dosyayı kapat, yeni dosyayı aktive et
4-) Kullanıcıdan onay al.
5-) Tanımlanan dizideki verileri sil.