Gantt Diyagramı yardım

sosorry

sosorry

Altın Üye
Katılım
17 Ocak 2007
Mesajlar
193
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
23-08-2025
iyi günler,

site üzerinden yapılmış olan gantt diyagramını kullanıyorum ancak bu diyagramı makro ile oluşturmak mümkün müdür? gün sayısı 3 olduğunda örneğin 4 hücre boyuyor ayrıca gün ve yapılacak iş kalemi ekledikçe sorun çıkıyor.

teşekkürler.
çalışmayı yaptığım dosyayı ekliyorum.
 

Ekli dosyalar

YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Başlama tarihi 1 temmuz, bitiş tarihi 3 temmuz olan bir işin süresi 2 gün müdür yoksa 3 gün mü? Ayın birinde başlayan bir iş iki gün sürerse ayın ikisinde bitmez mi?
 
sosorry

sosorry

Altın Üye
Katılım
17 Ocak 2007
Mesajlar
193
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
23-08-2025
YUSUF44' Alıntı:
Başlama tarihi 1 temmuz, bitiş tarihi 3 temmuz olan bir işin süresi 2 gün müdür yoksa 3 gün mü? Ayın birinde başlayan bir iş iki gün sürerse ayın ikisinde bitmez mi?
Genişletmek için tıkla ...
buna itirazım yok benim ancak kontroller yazıldığı gibi görmek istiyor. kabul etmiyorlar.
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Koşulu biçimlendirme formüllerindeki <= kısmındaki eşittiri silerseniz fazladan boyama yapmaz.
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Nasıl, neye göre birleştirme?
 
sosorry

sosorry

Altın Üye
Katılım
17 Ocak 2007
Mesajlar
193
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
23-08-2025
Yardim edebilir misiniz?
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki makroyu deneyiniz:

PHP: 
Sub gannt()
sonsat = WorksheetFunction.Max(8, Cells(Rows.Count, "D").End(3).Row)
sonsut = WorksheetFunction.Max(8, Cells(5, Columns.Count).End(xlToLeft).Column)
Range("D5", Cells(sonsat, sonsut)).Interior.Color = xlNone
hata = 0
If IsDate([H5]) = False Then
    [H5].Interior.Color = vbRed
    hata = hata + 1
End If
For gun = 9 To sonsut
    If IsDate(Cells(5, gun)) = False Then
        Cells(5, gun).Interior.Color = vbRed
        hata = hata + 1
    End If
    If Cells(5, gun) <> Cells(5, gun - 1) + 1 Then
        Cells(5, gun).Interior.Color = vbRed
        hata = hata + 1
    End If
Next
If hata > 0 Then
    MsgBox "Tarih diziliminde " & hata & " adet hatalı hücre bulundu ve kırmızı ile işaretlendi!" _
        & Chr(10) & Chr(10) & "Lütfen önce tarih hücrelerini düzeltin!", vbCritical
    Exit Sub
End If
hata = 0
For i = 8 To sonsat
    If IsDate(Cells(i, "D")) = False Then
        Cells(i, "D").Interior.Color = vbRed
        hata = hata + 1
    ElseIf IsDate(Cells(i, "F")) = False Then
        Cells(i, "F").Interior.Color = vbRed
        hata = hata + 1
    ElseIf Cells(i, "D") >= Cells(i, "F") Then
        Range("D" & i & ":F" & i).Interior.Color = vbRed
        hata = hata + 1
        GoTo 10
    End If
    gunyok = 0
    For gun = 8 To sonsut
        If Cells(5, gun) >= Cells(i, "D") And Cells(5, gun) < Cells(i, "F") Then
            gunyok = gunyok + 1
            If i Mod 2 = 0 Then
                Cells(i, gun).Interior.Color = 65535
            Else
                Cells(i, gun).Interior.Color = 49407
            End If
        End If
    Next
    If gunyok = 0 Then
        Range(Cells(i, "D"), Cells(i, sonsut)).Interior.Color = vbRed
    End If
10:
Next
If hata > 0 Or gunyok = 0 Then
    MsgBox "İşlem tamamlandı." & Chr(10) & Chr(10) & "Bazı hatalar bulundu ve hatalı hücreler kırmızıya boyandı!" _
        & Chr(10) & Chr(10) & "Hatalı hücreleri düzelttikten sonra makroyu tekrar çalıştırınız.", vbCritical
Else
    MsgBox "İşlem tamamlandı." & Chr(10) & Chr(10) & "Herhangi bir hata bulunamadı!", vbInformation
End If
End Sub
 
sosorry

sosorry

Altın Üye
Katılım
17 Ocak 2007
Mesajlar
193
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
23-08-2025
YUSUF44' Alıntı:
Aşağıdaki makroyu deneyiniz:

PHP: 
Sub gannt()
sonsat = WorksheetFunction.Max(8, Cells(Rows.Count, "D").End(3).Row)
sonsut = WorksheetFunction.Max(8, Cells(5, Columns.Count).End(xlToLeft).Column)
Range("D5", Cells(sonsat, sonsut)).Interior.Color = xlNone
hata = 0
If IsDate([H5]) = False Then
    [H5].Interior.Color = vbRed
    hata = hata + 1
End If
For gun = 9 To sonsut
    If IsDate(Cells(5, gun)) = False Then
        Cells(5, gun).Interior.Color = vbRed
        hata = hata + 1
    End If
    If Cells(5, gun) <> Cells(5, gun - 1) + 1 Then
        Cells(5, gun).Interior.Color = vbRed
        hata = hata + 1
    End If
Next
If hata > 0 Then
    MsgBox "Tarih diziliminde " & hata & " adet hatalı hücre bulundu ve kırmızı ile işaretlendi!" _
        & Chr(10) & Chr(10) & "Lütfen önce tarih hücrelerini düzeltin!", vbCritical
    Exit Sub
End If
hata = 0
For i = 8 To sonsat
    If IsDate(Cells(i, "D")) = False Then
        Cells(i, "D").Interior.Color = vbRed
        hata = hata + 1
    ElseIf IsDate(Cells(i, "F")) = False Then
        Cells(i, "F").Interior.Color = vbRed
        hata = hata + 1
    ElseIf Cells(i, "D") >= Cells(i, "F") Then
        Range("D" & i & ":F" & i).Interior.Color = vbRed
        hata = hata + 1
        GoTo 10
    End If
    gunyok = 0
    For gun = 8 To sonsut
        If Cells(5, gun) >= Cells(i, "D") And Cells(5, gun) < Cells(i, "F") Then
            gunyok = gunyok + 1
            If i Mod 2 = 0 Then
                Cells(i, gun).Interior.Color = 65535
            Else
                Cells(i, gun).Interior.Color = 49407
            End If
        End If
    Next
    If gunyok = 0 Then
        Range(Cells(i, "D"), Cells(i, sonsut)).Interior.Color = vbRed
    End If
10:
Next
If hata > 0 Or gunyok = 0 Then
    MsgBox "İşlem tamamlandı." & Chr(10) & Chr(10) & "Bazı hatalar bulundu ve hatalı hücreler kırmızıya boyandı!" _
        & Chr(10) & Chr(10) & "Hatalı hücreleri düzelttikten sonra makroyu tekrar çalıştırınız.", vbCritical
Else
    MsgBox "İşlem tamamlandı." & Chr(10) & Chr(10) & "Herhangi bir hata bulunamadı!", vbInformation
End If
End Sub
Genişletmek için tıkla ...
CommandButton1_Click() olarak mı uygulayacağım?
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Bu kodları bir modül yapıştırıp düğmenin koduna gannt yazmanız ya da bu kodların ilk ve son satırları arasındakileri kopyalayıp düğmenin koduna yapıştırmanız yeterlidir.
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Cepten kontrol edemiyorum. Verdiğim kodların ilk yani Sub ve son yani End Sub satırları hariç kopyalayın. Dosyanızda belirttiğiniz düğmenin click kodlarını açın ve araya yapıştırın.

Ya da kodun tamamını kopyalayın, VBA sayfasında insert menüsünü açıp module seçin ve açılan sayfaya kodları yapıştırın. İster düğmenin click koduna gannt yazın isterseniz sayfaya bir düğme ekleyip bu düğmeye gannt makrosunu atayın.
 
sosorry

sosorry

Altın Üye
Katılım
17 Ocak 2007
Mesajlar
193
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
23-08-2025
hallettim teşekkür ederim. elinize sağlık.
 
Son düzenleme:
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
İstediğiniz gibi olmuş mu?
 
sosorry

sosorry

Altın Üye
Katılım
17 Ocak 2007
Mesajlar
193
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
23-08-2025
kesinlikle çok iş görecek. planlama birimi var zaten ancak kendi önümüzü görmek açısından oldukça faydalı olacak. tekrar teşekkürler.
 
sosorry

sosorry

Altın Üye
Katılım
17 Ocak 2007
Mesajlar
193
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
23-08-2025
Günaydın.
Ben bu aşağıdaki kodları nasıl birleştirebilirim? Yani sub gantt_click () yaptığımda hem grafiği boyayacak hem de silmiş olduğum tarihlerin boyamasını kaldıracak. 2 farklı buton olarak yaptım ancak tek butonda çözebilir miyim?

Private Sub CommandButton1_Click()
sonsat = WorksheetFunction.Max(8, Cells(Rows.Count, "A").End(1).Row)
sonsut = WorksheetFunction.Max(8, Cells(5, Columns.Count).End(xlToRight).Column)

For iRow = 8 To sonsat
If IsDate(Cells(iRow, "D")) = False Then
Range(Cells(iRow, 8), Cells(iRow, sonsut)).Interior.Color = xlNone
End If
Next iRow
End Sub

Private Sub gantt_Click()
sonsat = WorksheetFunction.Max(8, Cells(Rows.Count, "D").End(3).Row)
sonsut = WorksheetFunction.Max(8, Cells(5, Columns.Count).End(xlToLeft).Column)
Range("D5", Cells(sonsat, sonsut)).Interior.Color = xlNone
hata = 0
If IsDate([H5]) = False Then
[H5].Interior.Color = vbRed
hata = hata + 1
End If
For gun = 9 To sonsut
If IsDate(Cells(5, gun)) = False Then
Cells(5, gun).Interior.Color = vbRed
hata = hata + 1
End If
If Cells(5, gun) <> Cells(5, gun - 1) + 1 Then
Cells(5, gun).Interior.Color = vbRed
hata = hata + 1
End If
Next
If hata > 0 Then
MsgBox "Tarih diziliminde " & hata & " adet hatalı hücre bulundu ve kırmızı ile işaretlendi!" _
& Chr(10) & Chr(10) & "Lütfen önce tarih hücrelerini düzeltin!", vbCritical
Exit Sub
End If
hata = 0
For i = 8 To sonsat
If IsDate(Cells(i, "D")) = False Then
Cells(i, "D").Interior.Color = vbRed
hata = hata + 1
ElseIf IsDate(Cells(i, "F")) = False Then
Cells(i, "F").Interior.Color = vbRed
hata = hata + 1
ElseIf Cells(i, "D") >= Cells(i, "F") Then
Range("D" & i & ":F" & i).Interior.Color = vbRed
hata = hata + 1
GoTo 10
End If
gunyok = 0
For gun = 8 To sonsut
If Cells(5, gun) >= Cells(i, "D") And Cells(5, gun) < Cells(i, "F") Then
gunyok = gunyok + 1
If i Mod 2 = 0 Then
Cells(i, gun).Interior.Color = 65535
Else
Cells(i, gun).Interior.Color = 49407
End If
End If
Next
If gunyok = 0 Then
Range(Cells(i, "D"), Cells(i, sonsut)).Interior.Color = vbRed
End If
10:
Next
If hata > 0 Or gunyok = 0 Then
MsgBox "Islem tamamlandi." & Chr(10) & Chr(10) & "Bazi hatalar bulundu ve hatali hucreler kirmiziya boyandi!" _
& Chr(10) & Chr(10) & "Hatali hucreleri duzelttikten sonra makroyu tekrar calistiriniz.", vbCritical
Else
MsgBox "Islem tamamlandi." & Chr(10) & Chr(10) & "Herhangi bir hata bulunamadi!", vbInformation
End If
End Sub
 
sosorry

sosorry

Altın Üye
Katılım
17 Ocak 2007
Mesajlar
193
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
23-08-2025
olmuyor mu? yapılamaz mı?
 
sosorry

sosorry

Altın Üye
Katılım
17 Ocak 2007
Mesajlar
193
Excel Vers. ve Dili
Office 365
Altın Üyelik Bitiş Tarihi
23-08-2025
sosorry' Alıntı:
Günaydın.
Ben bu aşağıdaki kodları nasıl birleştirebilirim? Yani sub gantt_click () yaptığımda hem grafiği boyayacak hem de silmiş olduğum tarihlerin boyamasını kaldıracak. 2 farklı buton olarak yaptım ancak tek butonda çözebilir miyim?

Private Sub CommandButton1_Click()
sonsat = WorksheetFunction.Max(8, Cells(Rows.Count, "A").End(1).Row)
sonsut = WorksheetFunction.Max(8, Cells(5, Columns.Count).End(xlToRight).Column)

For iRow = 8 To sonsat
If IsDate(Cells(iRow, "D")) = False Then
Range(Cells(iRow, 8), Cells(iRow, sonsut)).Interior.Color = xlNone
End If
Next iRow
End Sub

Private Sub gantt_Click()
sonsat = WorksheetFunction.Max(8, Cells(Rows.Count, "D").End(3).Row)
sonsut = WorksheetFunction.Max(8, Cells(5, Columns.Count).End(xlToLeft).Column)
Range("D5", Cells(sonsat, sonsut)).Interior.Color = xlNone
hata = 0
If IsDate([H5]) = False Then
[H5].Interior.Color = vbRed
hata = hata + 1
End If
For gun = 9 To sonsut
If IsDate(Cells(5, gun)) = False Then
Cells(5, gun).Interior.Color = vbRed
hata = hata + 1
End If
If Cells(5, gun) <> Cells(5, gun - 1) + 1 Then
Cells(5, gun).Interior.Color = vbRed
hata = hata + 1
End If
Next
If hata > 0 Then
MsgBox "Tarih diziliminde " & hata & " adet hatalı hücre bulundu ve kırmızı ile işaretlendi!" _
& Chr(10) & Chr(10) & "Lütfen önce tarih hücrelerini düzeltin!", vbCritical
Exit Sub
End If
hata = 0
For i = 8 To sonsat
If IsDate(Cells(i, "D")) = False Then
Cells(i, "D").Interior.Color = vbRed
hata = hata + 1
ElseIf IsDate(Cells(i, "F")) = False Then
Cells(i, "F").Interior.Color = vbRed
hata = hata + 1
ElseIf Cells(i, "D") >= Cells(i, "F") Then
Range("D" & i & ":F" & i).Interior.Color = vbRed
hata = hata + 1
GoTo 10
End If
gunyok = 0
For gun = 8 To sonsut
If Cells(5, gun) >= Cells(i, "D") And Cells(5, gun) < Cells(i, "F") Then
gunyok = gunyok + 1
If i Mod 2 = 0 Then
Cells(i, gun).Interior.Color = 65535
Else
Cells(i, gun).Interior.Color = 49407
End If
End If
Next
If gunyok = 0 Then
Range(Cells(i, "D"), Cells(i, sonsut)).Interior.Color = vbRed
End If
10:
Next
If hata > 0 Or gunyok = 0 Then
MsgBox "Islem tamamlandi." & Chr(10) & Chr(10) & "Bazi hatalar bulundu ve hatali hucreler kirmiziya boyandi!" _
& Chr(10) & Chr(10) & "Hatali hucreleri duzelttikten sonra makroyu tekrar calistiriniz.", vbCritical
Else
MsgBox "Islem tamamlandi." & Chr(10) & Chr(10) & "Herhangi bir hata bulunamadi!", vbInformation
End If
End Sub
Genişletmek için tıkla ...
soru hala güncel
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst