Gantt Diyagramı yardım

sosorry · 20 Ocak 2020

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.

sosorry · 20 Ocak 2020

sanırım ilk dosya ile bu dosyayı birleştirebilirsem istediğimi yapmış olacağım. yardım eder misiniz?

YUSUF44 · 20 Ocak 2020

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 · 20 Ocak 2020

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?

buna itirazım yok benim ancak kontroller yazıldığı gibi görmek istiyor. kabul etmiyorlar.

YUSUF44 · 20 Ocak 2020

Koşulu biçimlendirme formüllerindeki <= kısmındaki eşittiri silerseniz fazladan boyama yapmaz.

sosorry · 20 Ocak 2020

YUSUF44' Alıntı:
Koşulu biçimlendirme formüllerindeki <= kısmındaki eşittiri silerseniz fazladan boyama yapmaz.

teşekkürler, peki dediğim gibi birleştirme yapabiliyor muyuz?

YUSUF44 · 20 Ocak 2020

Nasıl, neye göre birleştirme?

sosorry · 20 Ocak 2020

YUSUF44' Alıntı:
Nasıl, neye göre birleştirme?

dosya ekleyerek açıklamaya çalıştım umarım olmuştur.

sosorry · 20 Ocak 2020

Yardim edebilir misiniz?

YUSUF44 · 21 Ocak 2020

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 · 21 Ocak 2020

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

CommandButton1_Click() olarak mı uygulayacağım?

YUSUF44 · 21 Ocak 2020

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.

sosorry · 21 Ocak 2020

YUSUF44' Alıntı:
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.

yapamadım ama bakar mısınız?

YUSUF44 · 21 Ocak 2020

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 · 22 Ocak 2020

hallettim teşekkür ederim. elinize sağlık.

YUSUF44 · 22 Ocak 2020

İstediğiniz gibi olmuş mu?

sosorry · 22 Ocak 2020

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 · 27 Ocak 2020

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 · 27 Ocak 2020

olmuyor mu? yapılamaz mı?

sosorry · 28 Ocak 2020

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

soru hala güncel

Gantt Diyagramı yardım

sosorry

Ekli dosyalar

sosorry

Ekli dosyalar

YUSUF44

Destek Ekibi

sosorry

YUSUF44

Destek Ekibi

sosorry

YUSUF44

Destek Ekibi

sosorry

Ekli dosyalar

sosorry

YUSUF44

Destek Ekibi

sosorry

YUSUF44

Destek Ekibi

sosorry

Ekli dosyalar

YUSUF44

Destek Ekibi

sosorry

YUSUF44

Destek Ekibi

sosorry

sosorry

sosorry

sosorry