Gün hesaplama

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,314
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Selamlar,

Ekteki örnek dosyayı incelermisiniz. Siz I sütununa değer girdikçe girdiğiniz değer kadar sütun renklenecektir. Renklendirme işlemi koşullu biçimlendirme ile yapılmıştır.
 

Ekli dosyalar

Katılım
7 Temmuz 2008
Mesajlar
130
Excel Vers. ve Dili
2003 - 2007
Hocam biraz daha açıklamaya çalıştım.Tabi 1.işlemin üretimi durmuyor parça sayısı bitene kadar devam ediyor( grafiğin uzunluguda 1. işlem için toplam süre kadar olacak) . bu 2. ve 3. (diğer) işlemler içinde böyle
 

Ekli dosyalar

Son düzenleme:
Katılım
7 Temmuz 2008
Mesajlar
130
Excel Vers. ve Dili
2003 - 2007
son halinde herşey
 
Son düzenleme:
Katılım
7 Temmuz 2008
Mesajlar
130
Excel Vers. ve Dili
2003 - 2007
son hali

Dosyaya eklemeler yaptım istediklerim içinde yazıyor. Şimdiden yardımlarınız için teşekkürler
 

Ekli dosyalar

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,712
Excel Vers. ve Dili
Excel 2019 Türkçe
Umarım doğru anlamışımdır.
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    k = 11
    Cells.Interior.Color = xlNone
    Son = [f65536].End(3).Row
    For i = 54 To Son
       If Cells(i, "i") = 0 Then
         Range(Cells(i, 11), Cells(i, Cells(i, "f") * 2 + 10)).Interior.Color = vbRed
       Else
        Range(Cells(i, k), Cells(i, (Cells(i, "f") * Cells(i, "i")) * 2 + k - 1)).Interior.Color = vbRed
       End If
        k = k + Cells(i, "i") * 2
    Next
End Sub
 

Ekli dosyalar

Son düzenleme:
Katılım
7 Temmuz 2008
Mesajlar
130
Excel Vers. ve Dili
2003 - 2007
hamit bey sanırım olmuş bir inceleyeyim teşekkür ederim
 
Katılım
7 Temmuz 2008
Mesajlar
130
Excel Vers. ve Dili
2003 - 2007
Hamit bey her satırı farklı renk yapabilirmiyiz.
 
Katılım
7 Temmuz 2008
Mesajlar
130
Excel Vers. ve Dili
2003 - 2007
bir iki eksik var

Hamit bey ekte dosyada gerekenleri yazdım İnş. yapabilirsiniz. Şimdiden teşekkürler
 

Ekli dosyalar

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,712
Excel Vers. ve Dili
Excel 2019 Türkçe
Renk konusu da yapılabilir. Boş olduğum bir zaman uğraşırım.
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,712
Excel Vers. ve Dili
Excel 2019 Türkçe
Aşağıdaki şekilde dener misiniz ?
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    k = 11
    Cells.Interior.Color = xlNone
    Son = [f65536].End(3).Row
    For i = 54 To Son
       If Cells(i, "i") = 0 Then
         Range(Cells(i, 11), Cells(i, Cells(i, "f") * 2 + 10)).Interior.ColorIndex = Int((56 * Rnd) + 1)
       Else
        Range(Cells(i, k), Cells(i, (Cells(i, "f") * Cells(i, "i")) * 2 + k - 1)).Interior.ColorIndex = Int((56 * Rnd) + 1)
       End If
        k = k + Cells(i, "i") * 2
    Next
End Sub
 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,712
Excel Vers. ve Dili
Excel 2019 Türkçe
Aslına bakarsanız sorunuz hakkında çok az şey aklımda kaldı. Umarım doğru yorumlamışımdır.
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    k = 11
    Cells.Interior.Color = xlNone
    Son = [f65536].End(3).Row
    For i = 54 To Son
       If Cells(i, "i") = 0 Then
         Range(Cells(i, 11), Cells(i, Cells(i, "h") * 2 + 10)).Interior.ColorIndex = Int((56 * Rnd) + 1)
       Else
        Range(Cells(i, k), Cells(i, (Cells(i, "h")) * 2 + k - 1)).Interior.ColorIndex = Int((56 * Rnd) + 1)
       End If
        k = k + Cells(i, "i") * 2
    Next
End Sub
 
Katılım
7 Temmuz 2008
Mesajlar
130
Excel Vers. ve Dili
2003 - 2007
bir ufak düzeltme daha istiyor

Sayın Hamitcan
Dosya içinde gereken yazılı sanırım oda olursa tamam olacak inş. şimdiden teşekkürler
 

Ekli dosyalar

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,712
Excel Vers. ve Dili
Excel 2019 Türkçe
Cevapta tekrar eksiklik görüyorsanız, kısıtlarınızı madde madde tekrar belirtip sorunuzu bu şekilde sorun.
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    k = 11
    Cells.Interior.Color = xlNone
    Son = [f65536].End(3).Row
    For i = 54 To Son
       If Cells(i, "i") = 0 Then
         Range(Cells(i, 11), Cells(i, Cells(i, "h") * 2 + 10)).Interior.ColorIndex = Int((56 * Rnd) + 1)
       ElseIf Cells(i - 1, "i") = 0 Then
        Range(Cells(i, Cells(i, "h") * 2 + 10), Cells(i, (Cells(i, "h")) * 4 + 10)).Interior.ColorIndex = Int((56 * Rnd) + 1)
       Else
        Range(Cells(i, k), Cells(i, (Cells(i, "h")) * 2 + k - 1)).Interior.ColorIndex = Int((56 * Rnd) + 1)
       End If
        k = k + Cells(i, "i") * 2
    Next
End Sub
 
Üst