Hey there!

It looks like you're enjoying Hesaptablosu - Akademik Excel Forumu but haven't created an account yet. Why not take a minute to register for your own free account now? As a member you get free access to all of our forums and posts plus the ability to post your own messages, communicate directly with other members and much more. Register now!

Already a member? Login at the top of this page to stop seeing this message.

Toplam 3 sonuçtan 1 ile 3 arasındakiler gösteriliyor.

Konu: Aylara Göre Günleri Getirme

  1. #1
    Üye
    Üyelik tarihi
    May 2016
    Mesajlar
    64

    Aylara Göre Günleri Getirme

    Arkadaşlar çalışmanın kod sayfasında sayfaları sağa doğru kopyaladıkça aylara göre isimlerini ve sayfa üst bilgisini değiştirip hücreleri boşaltan kodlar mevcut olup yapmak istediğim şey aylara göre günleri getirmek istiyorum.


    http://www.dosya.tc/server11/ot8tur/MYSGR.rar.html

  2. #2
    Yeni Üye
    Üyelik tarihi
    Dec 2017
    Mesajlar
    28
    Dizinizi azcık değiştirdim.

    Sizin kodlara da bir şeyler ilave ettim. Aşağıdaki kodları deneyiniz.
    Kod:
    Sub sekerSayfa()
    
    Dim aylar As Variant
     aylar = Array("OCAK", "ŞUBAT", "MART", "NİSAN", "MAYIS", "HAZİRAN", "TEMMUZ", "AĞUSTOS", "EYLÜL", "EKİM", "KASIM", "ARALIK")
     sayfaAd = ActiveSheet.Name
     ActiveSheet.Copy Before:=Sheets(1)
     ActiveSheet.Move after:=Sheets(ThisWorkbook.Sheets.Count)
     ActiveSheet.Range("c4:h34").ClearContents
    For i = 0 To 10
      If sayfaAd = aylar(i) Then
          ActiveSheet.Name = aylar(i + 1)
          For k = 4 To 34
          Tarih = DateSerial(2018, i + 2, k - 3)
          If Month(Tarih) = i + 2 Then
          Cells(k, 2) = Format(Tarih, "dddd")
          Else
          son = Cells(k, 2).End(xlDown).Row
          Range(Cells(k, 1), Cells(son, 8)).ClearContents
          GoTo ATLA
          End If
          Next k
      End If
    Next i
    ATLA:
    ActiveSheet.Range("B1:H1").Merge
        ActiveSheet.Range("B1").Value = ActiveSheet.Name & " " & Year(Date)
        ActiveSheet.Rows(1).RowHeight = 35
        With ActiveSheet.Range("B1:H1")
            .Font.Name = "Arial"
            .Font.Size = 24
            .Font.Bold = True
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
        End With
    
    End Sub

  3. #3
    Üye
    Üyelik tarihi
    May 2016
    Mesajlar
    64
    Sayın NextLevel ilginize teşekkür ederim.

Konu Bilgisi

Users Browsing this Thread

Şu anda 1 üyemiz bu konuya göz atıyor. (0 kayıtlı üye ve 1 misafir.)

Yetkileriniz

  • Konu Acma Yetkiniz Yok
  • Cevap Yazma Yetkiniz Yok
  • Eklenti Yükleme Yetkiniz Yok
  • Mesajınızı Değiştirme Yetkiniz Yok
  •