DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
[URL="http://www.excel.web.tr/f48/retim-plany-t151334.html"][B][COLOR="Blue"][COLOR="Red"]Üretim Planı[/COLOR] => konu sayfasına gitmek için fareyle tıklayın.[/COLOR][/B][/URL]
) ellerinize sağlık yinedeSub OPTIMIZE_BRN()
Rem Tanımlamalar yapılıyor.
Dim yaz, yaz1 As Currency
Rem Kod içinde kullanılacak sayfa ve fonksiyon özelliği kısa isimlere atanıyor.
Set sh = Sheets("ana sayfa"): Set wf = Application.WorksheetFunction
Rem kod hata verirse devam etmesi için hataları gözardı etmesi sağlanıyor.
On Error Resume Next
Rem ANA SAYFA isimli sayfada A sütununda en son satır tespit ediliyor.
ason = sh.Cells(Rows.Count, 1).End(3).Row
Rem Son satır 4 ise işlem sonlandırılıyor.
If ason = 4 Then Exit Sub
Rem "TEMIZLE" isimli makro çalıştırılıyor.
Call TEMIZLE
Rem "h" isimli döngü başlıyor.
For h = 4 To 5
Rem "sat" isimli döngü başlıyor.
For sat = 4 To ason
Rem "sat" değerine ait 2. sütundaki veri ile bir önceki satıra ait 2. sütundaki veri birbirine eşit değilse koşuluna bakılıyor.
If sh.Cells(sat, 2) <> sh.Cells(sat - 1, 2) Then
Rem "ılk" değişkenine "sat" değeri atanıyor. "son" değişkeni "ılk-1+şube sayısı" olarak atanıyor. Yani şube satırları işleme alınıyor.
ilk = sat: son = ilk - 1 + wf.CountIf(sh.Range("B" & sat & ":B" & ason), sh.Cells(ilk, 2))
Rem Şubeler için "ssat" isimli döngü başlıyor.
For ssat = ilk To son
Rem Döngüdeki satıra ait "h" döngüsündeki sütuna ait hücrenin rengi kırmızı ise koşuluna bakılıyor.
If sh.Cells(ssat, h).Interior.Color = vbRed Then
Rem İlgili satıra T sütununa kadar kırmızı dolgu veriliyor.
sh.Range(Cells(ssat, h), sh.Cells(ssat, 20)).Interior.Color = vbRed
Rem İlgili satırdaki T sütunundaki değer sıfırlanıyor.
sh.Cells(ssat, 20) = 0
Rem Hücrenin rengi kırmızı koşulunu sağladığı için 20 numaralı kod satırına yönlendiriliyor.
GoTo 20
Else
Rem Eğer sorgulanan hücrenin dolgu rengi kırmızı değilse koşuluna bakılıyor.
Rem Haftalara ait ilgili satırdaki hücrelerin dolgu rengi kaldırılıyor.
sh.Range(Cells(ssat, 6), sh.Cells(ssat, 10)).Interior.Color = xlNone
sh.Range(Cells(ssat, 12), sh.Cells(ssat, 18)).Interior.Color = xlNone
End If
Rem "sutt" döngüsü başlıyor. Hafta hücreleri döngüye alınıyor.
For sutt = 6 To 18
Rem "ssat" döngüsündeki ilgili satırdaki "h" döngüsündeki ilgili sütundaki hücrenin dolgu rengi sarı ise koşuluna bakılıyor.
sh.Cells(ssat, h).Interior.Color = vbYellow
Rem "sutt" değeri 11 ise "sutt" değeri 1 arttırılıyor.
If sutt = 11 Then sutt = sutt + 1
Rem İlgili şube koduna ait ilgili haftanın gün toplamı alınıyor.
suttop = wf.Sum(sh.Range(sh.Cells(sat, sutt), sh.Cells(son, sutt)))
Rem İlgili satırdaki haftanın tüm günlerinin toplamı alınıp ilk hafta toplamı düşülüyor. Yani İkinci hafta toplamına ulaşılıyor.
sattop = wf.Sum(Range(sh.Cells(ssat, 6), sh.Cells(ssat, 18))) - sh.Cells(ssat, 11)
Rem "htop" adlı değişkene ilgili satırdaki "h" döngüsündeki sütuna ait hücredeki değer atanıyor.
htop = sh.Cells(ssat, h)
Rem "h" döngüsündeki sütun değeri 5 ise "htop" değişkenine ilgili satırdaki D sütunundaki değer ekleniyor. Yani D-E sütunlarındaki değerler toplanıyor.
If h = 5 Then htop = htop + sh.Cells(ssat, 4)
Rem "yaz" isimli değişkene aşağıdaki satırdaki değerleri en küçük olanı atanıyor.
yaz = wf.Min(htop, 1 - suttop, htop - sattop)
Rem Eğer "yaz" değeri sıfırdan büyükse işleme devam et koşuluna bakılıyor.
If yaz > 0 Then
Rem ANA SAYFA C1 hücresi boşsa "k" değişkeni sıfırlanıyor. Burada makronun çalışma hızıyla ilgili kurgular yapılıyor.
If sh.[C1] = "" Then k = 0
Rem ANA SAYFA C1 hücresi boş değilse "k" değişkeni (10-C1)*200000 işlemi sonucunu alıyor.
If sh.[C1] <> "" Then k = (10 - sh.[C1]) * 200000
Rem "sayac" isimli döngü başlıyor.
For sayac = 0 To k
Rem Eğer "say" değeri "k" değerine eşitse döngüden çıkılıyor.
If say = k Then Exit For
Rem "say" değeri 1 arttırılıyor.
say = say + 1
Next
Rem "say" değişkenine 1 değeri atanıyor.
say = 1
Rem İlgili satır ve sütun döngüsündeki hücreye "yaz" değeri ekleniyor.
sh.Cells(ssat, sutt) = sh.Cells(ssat, sutt) + yaz
End If
Rem "sutt" değişkeni 11 den küçükse koşuluna bakılıyor. İlgili satırdaki 11. sütundaki hücreye "yaz" değeri ekleniyor.
If sutt < 11 Then sh.Cells(ssat, 11) = sh.Cells(ssat, 11) + yaz
Rem "sutt" değişkeni 11 den büyükse koşuluna bakılıyor. İlgili satırdaki 19. sütundaki hücreye "yaz" değeri ekleniyor.
If sutt > 11 Then sh.Cells(ssat, 19) = sh.Cells(ssat, 19) + yaz
Next
Rem Üst bölümde bulunan "GoTo 20" koda satırı alt bölüme yönlendirilmektedir.
Rem Burada ilgili satırdaki "h" döngüsündeki sütuna ait hücrenin dolgu rengi kırmızı değilse hücreye 24 (açık mor) numaralı dolgu rengi atanıyor.
20: If sh.Cells(ssat, h).Interior.Color <> vbRed Then sh.Cells(ssat, h).Interior.ColorIndex = 24
Next
Rem Eğer "sat" değeri büyük eşitse "ason" değerinden ve "h" değeri eşit 5 ise 30 ile başlayan kod satırına git.
If sat >= ason And h = 5 Then GoTo 30
Rem Eğer "sat" değeri büyük eşitse "ason" değerinden ve "h" değeri eşit 4 ise 40 ile başlayan kod satırına git.
If sat >= ason And h = 4 Then GoTo 40
Rem "sat" değişkenine "ssat" değişkeni -1 değeri tanımlanıyor.
sat = ssat - 1
End If
Next
40: Next
Rem "Veri" isimli döngü başlıyor. "T" sütunundaki hücreler döngüye alınıyor.
30: For Each Veri In sh.Range("T4:T" & ason)
Rem İlgili satırdaki "D" sütunundaki hücrenin dolgu rengi kırmızı değilse koşuluna bakılıyor.
If sh.Cells(Veri.Row, 4).Interior.Color <> vbRed Then
Rem "Toplam1" değişkenine ilgili satırdaki "D-E" sütunlarındaki değerler ekleniyor.
Toplam1 = Toplam1 + sh.Cells(Veri.Row, 4) + sh.Cells(Veri.Row, 5)
Rem "yaz1" değişkenine ilgili satırdaki "D-E" sütunlarındaki değerler eklenirken K ve S sütunundaki değerler çıkarılıyor.
yaz1 = sh.Cells(Veri.Row, 4) + sh.Cells(Veri.Row, 5) - sh.Cells(Veri.Row, 11) - sh.Cells(Veri.Row, 19)
Rem İlgili hücreye ulaşılan "yaz1" değeri yazdırılıyor.
Veri.Value = yaz1
Rem "yaz1" değeri sıfırdan büyükse ilgili hücrenin dolgu rengi 6 (sarı) olarak değiştiriliyor. Yazı rengi de kırmızı olarak değiştiriliyor.
If yaz1 > 0 Then Veri.Interior.ColorIndex = 6: Veri.Font.Color = vbRed
Rem "Toplam" değişkeni üzerinde hücredeki değer ekleniyor.
Toplam = Toplam + Veri.Value
Rem "yaz1" değeri sıfıra eşitse ilgili hücrenin dolgu rengi 24 (açık mor) olarak değiştiriliyor. Yazı rengi de 17 (orta mor) olarak değiştiriliyor.
If yaz1 = 0 Then Veri.Interior.ColorIndex = 24: Veri.Font.ColorIndex = 17
Else
Rem İlgili satırdaki "D" sütunundaki hücrenin dolgu rengi kırmızı ise koşuluna bakılıyor. İlgili hücrenin değeri sıfır ve yazı rengi kırmızı olarak değiştiriliyor.
Veri.Value = 0: Veri.Font.Color = vbRed
End If
Next
Rem Kullanıcıya yapılan işlemle ilgili bilgilendirme mesajı veriliyor.
MsgBox "İşlem tamamlandı." & vbLf & vbLf & _
"-- İşleme sokulan toplam miktar: " & Toplam1 & vbLf & _
"-- 3'üncü haftaya devreden miktar: " & Toplam, vbInformation, "..:: Ömer BARAN ::.."
End Sub
Sub TEMIZLE()
Rem Sayfa tanımlaması yapılıyor.
Set sh = Sheets("ana sayfa")
Rem A sütunundaki son satır tespit ediliyor.
ason = sh.Cells(Rows.Count, 1).End(3).Row
Rem İlgili hücre aralığının içeriği temizleniyor.
sh.Range("F4:T" & ason).ClearContents
Rem İlgili hücre aralığının dolgu rengi kaldırılıyor.
sh.Range("F4:S" & ason).Interior.Color = -4142
Rem İlgili hücre aralığının dolgu rengi 20 olarak ayarlanıyor.
sh.Range("K4:K" & ason).Interior.ColorIndex = 20
Rem İlgili hücre aralığının dolgu rengi 20 olarak ayarlanıyor.
sh.Range("S4:S" & ason).Interior.ColorIndex = 20
Rem İlgili hücre aralığının dolgu rengi 24 olarak ayarlanıyor.
sh.Range("T4:T" & ason).Interior.ColorIndex = 24
Rem İlgili hücre aralığının yazı rengi 17 olarak ayarlanıyor.
sh.Range("T4:T" & ason).Font.ColorIndex = 17
End SubÇok teşekkür ederim. Elinize sağlık. Bir sorum olacak size. Bu çalışmada kısıt 1 olmuş. 1i aşınca ertesi güne devrediyor işler. Ben 1 yerine örneğin 18 saat gibi bir kısıt koymak istesem bunu nerede yapmalıyım? 1 kısıtının konulduğu bir yer göremedim. Sanırım haftanın günlerinden ilerlenmiş yanlış anlamadıysam.