Fazla çalışma

[vuranoğlu]

Merhaba
Ekteki dosyada ayı değiştirip çalıştır dediğimizde
B kolonundaki birleştirilmiş hücreler hata veriyor.
Hatanın nedenini bulamadım.
Yardımcı olan arkadaşlara şimdiden teşekkürler

 

[Ömer BARAN]

Merhaba.

Hata nedir tam olarak anlayamadım, olmasını istediğiniz nedir çok net ifade etmemişsiniz ancak tahmin üzerine şunu söyleyeyim;

Sayfa1'in kod bölümündeki (ThisWorkbook/BuÇalışmaKitabı bölümündeki değil) Private Sub CommandButton1_Click() kod blokunda,
For J = 1 To son ..... Next döngüsü içerisinde yer alan tüm Cells(i, sut) kısımlarını Cells(i + J - 1, sut) olarak değiştirerek dener misiniz?
.

 

[vuranoğlu]

İlginize teşekkürler
Haziran ağustos ayları hatalı hafta sonları bilgilerini k sütununa alamadım
hafta sonlarını çift satır olarak renklensin.

 

[Ömer BARAN]

Fazla Çalışma isimli sayfanın kod bölümünde yer alan Private Sub CommandButton1_Click() kod blokunu aşağıdakiyle değiştirin.

Private Sub CommandButton1_Click()

Dim M As Date
Dim i As Long, J As Long
Dim yer1 As String, yillar As String, aylar As String

sat1 = 12 'yazmaya başlıyacağı ilk satır
sut1 = 2 'yazmaya başlıyacağı ilk sutun
sat2 = 73 'yazmaya başlıyacağı son satır
sut2 = "k" 'yazmaya başlıyacağı son sutun

Range(Cells(sat1, sut1), Cells(sat2, sut2)).ClearContents
Range(Cells(sat1, sut1), Cells(sat2, sut2)).Interior.ColorIndex = xlNone

aylar = Range(aylar1).Value
yillar = Range(yillar1).Value

yer1 = Val(Format("01." & Format(aylar, "MM") & "." & Format(yillar, "0000"), "mm"))

Ayin_Son_Gunu = DateSerial(yillar, yer1 + 1, 1) - 1
Ayin_Ilk_Gunu = DateSerial(yillar, yer1, 1)
son = Val(Format(Ayin_Son_Gunu, "dd"))

i = sat1
sut = sut1

For J = 1 To son
    If J = 41 Then
        sut = sut + 6
        i = sat1
    End If
    M = CDate(Format(J, "00") & "." & Format(aylar, "MM") & "." & Format(yillar, "0000"))
        Hicri_takvim1 (M)
    Cells(i + J - 1, sut).Value = J

    If Format(M, "DDDD") = "Pazar" Or Format(M, "DDDD") = "Cumartesi" Then
        Cells(i + J - 1, sut).Interior.ColorIndex = 8
        Cells(i + J - 1, sut + 1).Interior.ColorIndex = 19
        Cells(i + J - 1, sut + 2).Interior.ColorIndex = 19
        Cells(i + J - 1, sut + 3).Interior.ColorIndex = 19
        Cells(i + J - 1, sut + 4).Interior.ColorIndex = 19
        Cells(i + J - 1, sut + 5).Interior.ColorIndex = 19
        Cells(i + J - 1, sut + 6).Interior.ColorIndex = 19
        Cells(i + J - 1, sut + 7).Value = Format(M, "DDDD")
        Range(Cells(i + J - 1, sut + 7), Cells(i + J, sut + 7)).Interior.ColorIndex = 8
    End If
    
    If deg1 <> "" Or deg2 <> "" Then
        Cells(i + J - 1, sut).Interior.ColorIndex = 8
        Cells(i + J - 1, sut + 1).Interior.ColorIndex = 19
        Cells(i + J - 1, sut + 2).Interior.ColorIndex = 19
        Cells(i + J - 1, sut + 3).Interior.ColorIndex = 19
        Cells(i + J - 1, sut + 4).Interior.ColorIndex = 19
        Cells(i + J - 1, sut + 5).Interior.ColorIndex = 19
        Cells(i + J - 1, sut + 6).Interior.ColorIndex = 19
        Cells(i + J - 1, sut + 7).Value = "Bayram"
        Range(Cells(i + J - 1, sut + 7), Cells(i + J, sut + 7)).Interior.ColorIndex = 8
End If
i = i + 1
Next

End Sub

 

[vuranoğlu]

Teşerkkürler.
Bu çalışmada ay değişince tabloyu otomotik değiştirebilir miyiz?

 

[Ömer BARAN]

Sayfanın kod bölümüne ( Const yillar1 = "J5" 'YIL satırından hemen sonrasına) aşağıdaki kod blokunu yapıştırın ve
yine sayfanın kod bölümündeki Private Sub CommandButton1_Click() adını Sub hesapla() olarak değiştirin.

Ay veya yıl değiştirildiğinde kodlar gerekli işlemi yapar.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [I5, J5]) Is Nothing Then Exit Sub
    Call hesapla
End Sub

 

[vuranoğlu]

Merhaba
Fazla Çalışma isimli çalışmada kodlar çalıştığında tablonun tamamı temizleniyor.Temizle işleminde J ve K sütünları devre dışı kalabilir mi? B - I aralığı temizlensin.

 

[Ömer BARAN]

Merhaba.
Bu tür basit konuları kolaylıkla kendiniz de halledebilirsiniz.

Bunun için VBA ekranındaki ilgili makroyu ALT+F11 tuşlarına basarak görüntüledikten sonra,
F8 tuşuna basarak, kod'un yaptığı işlemleri adım adım (satır satır) görebilirsiniz.

Kod'daki silme satırı : Range(Cells(sat1, sut1), Cells(sat2, sut2)).ClearContents

burada 2 adet hücre adresi var; birincisi ilk hücre>> Cells(sat1, sut1) , ikincisi de son hücre>> Cells(sat2, sut2)
kod'un başında da bunlar tanımlanmış durumda; ilk satır sat1, ilk sütun sut1, son satır sat2, son sütun sut2 şeklinde.

Herneyse; hesapla isimli makronun baş tarafındaki sut2 = "k" kısmını sut2 = "I" olarak değiştirmeniz yeterli olur.

 

[vuranoğlu]

Yardımınız için teşekkür ederim.
F hücesindeki değerden c hücresindeki değeri çıkartıp j hücresine değeri yazdırabilir miyiz?

 

[Ömer BARAN]

.
Anladığım kadarıyla SAAT/DAKİKA işlemleri yapacaksınız ve verdiğim cevap sizi nihai sonuca da ulaştırmayacak.
Çünkü bir sonraki sorunuzun aynı şekilde K sütunu için geleceğini, ardından da bu ikisinin bütün olarak (SAAT : DAKİKA)
dikkate alınması gerektiğini söyleyeceksiniz.
En sonunda da asıl soru gelecek diye tahmin ediyorum, C : D 'deki saat gece yarısından önce (22:36 gibi) ve F : G'deki de gece yarısından sonra (02:54 gibi) bu durumda çıkartma işlemi nasıl olacak?

Her neyse, son sorunuzun cevabı olarak; mevcut kod'da aşağıdaki kırmızı satırın üstüne yeşil olan satırı ekleyin.

    Cells(i + J - 1, "J") = Cells(i + J - 1, "F") - Cells(i + J - 1, "C")
    If Format(M, "DDDD") = "Pazar" Or Format(M, "DDDD") = "Cumartesi" Then