• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Dağılım

  • Konbuyu başlatan Konbuyu başlatan Barons
  • Başlangıç tarihi Başlangıç tarihi
B

Barons

Altın Üye
Katılım
14 Mayıs 2005
Mesajlar
967
Excel Vers. ve Dili
Microsoft Ofis 365
Sn.Fedeal

Değerli katkılarınızla hazırlanan ekteki dosyada D harfinide ilave etmem gerekiyor.
Yardımcı olursanız çok memnun olurum.

Teşekkürler
 

Ekli dosyalar

Merhaba, d'yi ilave ettim kontrol edin umarım olmuştur,saygılar.
 

Ekli dosyalar

Çok teşekkürler ...elinize sağlık...çok makbule geçti.
 
işinize yaradıgına sevindim,iyi çalışmalar.
 
Sn.Fedeal hocam,
en son gönderdiğiniz macplan.rar dosyasında küçük bir ekleme yapmanız mümkünmüdür?
İlk başta tüm makinalar (A,B,C ve D) o günün tarihine ilaveten saat 15:00 da başlamaları gerekiyor.(S ve AF kolonlarındaki değerlerden bahsediyorum.)

örnek: Bugün 26.08.2009 değilde ,
26.08.2009 15:00:00 şeklinde.

çok çok teşekkürler
 
Bu konuda yardımınıza acil ihtiyacım var, Fedeal hocam,,,
 
Merhaba,hsb2 makrosunu alttaki ile değiştirin ak sütunundaki bugün formüllerinide kaldırın gerek kalmadı.Nereyi değiştirdigimi merak ederseniz kırmızı satırı değiştirdim.iyi çalışmalar.

Kod: 
Sub HSB2()
'CreateObject("WScript.Shell").Popup _
'"Lütfen bekleyin Makina Planlama işlemi yapılıyor", 4, "Uyarı"
SON = Sheets("Plan").Range("A65536").End(xlUp).Row
For Say = 2 To SON
Cells(1, "AS").Value = Say
Call HESAPLA2
'------I SÜTUNU----------
If Cells(Say, "I").Value = "" Then
Cells(Say, "S").Value = ""
Range("I" & Say & ":T" & Say).Interior.ColorIndex = xlNone
GoTo ATLA
End If
'--A---------------------I
If Cells(Say, "I").Value = "A" Or Cells(Say, "I").Value = "a" Then
If Cells(1, "AM").Value = 0 Then
Cells(Say, "S").Value = CDate(Date) + 0.625
Range("I" & Say & ":t" & Say).Interior.ColorIndex = 4
Else
Cells(Say, "S").Value = Cells(1, "AM").Value
Range("I" & Say & ":t" & Say).Interior.ColorIndex = 4
End If
End If
'--B---------------------I
If Cells(Say, "I").Value = "B" Or Cells(Say, "I").Value = "b" Then
If Cells(1, "AO").Value = 0 Then
Cells(Say, "S").Value = CDate(Date) + 0.625
Range("I" & Say & ":t" & Say).Interior.ColorIndex = 6
Else
Cells(Say, "S").Value = Cells(1, "AO").Value
Range("I" & Say & ":t" & Say).Interior.ColorIndex = 6
End If
End If
'--C---------------------I
If Cells(Say, "I").Value = "C" Or Cells(Say, "I").Value = "c" Then
If Cells(1, "AQ").Value = 0 Then
Cells(Say, "S").Value = CDate(Date) + 0.625
Range("I" & Say & ":t" & Say).Interior.ColorIndex = 7
Else
Cells(Say, "S").Value = Cells(1, "AQ").Value
Range("I" & Say & ":t" & Say).Interior.ColorIndex = 7
End If
End If
'--D---------------------I
If Cells(Say, "I").Value = "D" Or Cells(Say, "I").Value = "d" Then
If Cells(1, "AU").Value = 0 Then
Cells(Say, "S").Value = CDate(Date) + 0.625
Range("I" & Say & ":t" & Say).Interior.ColorIndex = 8
Else
Cells(Say, "S").Value = Cells(1, "AU").Value
Range("I" & Say & ":t" & Say).Interior.ColorIndex = 8
End If
End If
ATLA:
'------V SÜTUNU----------
If Cells(Say, "V").Value = "" Then
Cells(Say, "AF").Value = ""
Range("V" & Say & ":AG" & Say).Interior.ColorIndex = xlNone
GoTo ATLA1
End If
'--A---------------------V
If Cells(Say, "V").Value = "A" Or Cells(Say, "V").Value = "a" Then
If Cells(1, "AM").Value = 0 Then
Cells(Say, "AF").Value = CDate(Date) + 0.625
Range("V" & Say & ":AG" & Say).Interior.ColorIndex = 4
Else
Cells(Say, "AF").Value = Cells(1, "AM").Value
Range("V" & Say & ":AG" & Say).Interior.ColorIndex = 4
End If
End If
'--B---------------------V
If Cells(Say, "V").Value = "B" Or Cells(Say, "V").Value = "b" Then
If Cells(1, "AO").Value = 0 Then
Cells(Say, "AF").Value = CDate(Date) + 0.625
Range("V" & Say & ":AG" & Say).Interior.ColorIndex = 6
Else
Cells(Say, "AF").Value = Cells(1, "AO").Value
Range("V" & Say & ":AG" & Say).Interior.ColorIndex = 6
End If
End If
'--C---------------------V
If Cells(Say, "V").Value = "C" Or Cells(Say, "V").Value = "c" Then
If Cells(1, "AQ").Value = 0 Then
Cells(Say, "AF").Value = CDate(Date) + 0.625
Range("V" & Say & ":AG" & Say).Interior.ColorIndex = 7
Else
Cells(Say, "AF").Value = Cells(1, "AQ").Value
Range("V" & Say & ":AG" & Say).Interior.ColorIndex = 7
End If
End If
'--D---------------------V
If Cells(Say, "V").Value = "D" Or Cells(Say, "V").Value = "d" Then
If Cells(1, "AU").Value = 0 Then
Cells(Say, "AF").Value = CDate(Date) + 0.625
Range("V" & Say & ":AG" & Say).Interior.ColorIndex = 8
Else
Cells(Say, "AF").Value = Cells(1, "AU").Value
Range("V" & Say & ":AG" & Say).Interior.ColorIndex = 8
End If
End If
ATLA1:
Next
End Sub
 
Son düzenleme:
Çok teşekkürler, zahmet veriyorum ancak 2 hata tespit ettim.
1. bazı tarihler 01.01.1900 falan oluyor.
2. aynı satırda aynı harf olursa toplayarak gitmiyor. yani I ve V kolonunda örnek olarak söylüyorum A harfi varsa,T kolonundaki bitiş tarihi AF kolonunun başlangıç tarihi olması gerekiyor.Bu çok sık olan bir şey değil ancak aynı satıra denk gelirse ikisininde değeri aynı oluyor.Buda hatalı zaman kaymasına sebebp oluyor.oysa böyle durumda zincirleme birbirinin üzerine toplayarak gitmesi gerekiyor.
Anlatımım zayıftır umarım başarmışımdır.
 
1.Hatayı üstteki kodları düzelterek hallettim.(9.mesaj güncel)
 
çok teşekkürler...
2nci olayı sanırım anlatabilmişimdir.Bu işlemler arka arkaya olduğu için aynı gün içinde aynı isimdeki makinalar aynı anda başlamaları mümkün olmadığı için eğer aynı satırda denk gelirlerse arka arkaya olmaları gerekiyor.Yani ilkinin bitişi diğerinin başlangıcı olması gerekiyor.
 
Sn.Fedeal,
1nci sorun için teşekkürler..ikinci sorun için ise (eğerli...) ara çözümler oluşturmaya çalıştım ancak sorunu tam çözmüyor.Bu sebeple bir el atarsanız çok makbule geçecek...okyanustan geçtim ama şu dereyi geçemiyorum...

2nci sorunu tekrar hatırlatayım. dağıt dendiğinde eğer aynı satırda aynı harf var ise AF kolonunun başlangıç tarihi T kolonunun bitiş tarihinden başlayacak.yani eklenecek.Diğer mantık aynen devam ediyor..süper çalışıyor ancak bu seçenek olmadımı tamamınında bir anlamı kalmıyor çünkü sistem hatalı çalışmış oluyor...aynı anda bir makinaya 2 iş vermiş gibi bir anlam çıkıyor.
tekrar teşekkürler
 
Zannedersem oldu. :)
Bu ilk kodlar:

Kod: 
Sub HSB2()
son = Sheets("Plan").Range("A65536").End(xlUp).Row
    Range("s2:t" & son).ClearContents
    Range("af2:ag" & son).ClearContents
For Say = 2 To son
Cells(1, "AS").Value = Say
Call HESAPLA2
'------I SÜTUNU----------
If Cells(Say, "I").Value = "" Then
Cells(Say, "S").Value = ""
Range("I" & Say & ":T" & Say).Interior.ColorIndex = xlNone
GoTo ATLA
End If
'--A---------------------I
If Cells(Say, "I").Value = "A" Or Cells(Say, "I").Value = "a" Then
If Cells(1, "AM").Value < 100 Then
Cells(Say, "S").Value = CDate(Date) + 0.625
Range("I" & Say & ":t" & Say).Interior.ColorIndex = 4
Else
Cells(Say, "S").Value = Cells(1, "AM").Value
Range("I" & Say & ":t" & Say).Interior.ColorIndex = 4
End If
End If
'--B---------------------I
If Cells(Say, "I").Value = "B" Or Cells(Say, "I").Value = "b" Then
If Cells(1, "AO").Value < 100 Then
Cells(Say, "S").Value = CDate(Date) + 0.625
Range("I" & Say & ":t" & Say).Interior.ColorIndex = 6
Else
Cells(Say, "S").Value = Cells(1, "AO").Value
Range("I" & Say & ":t" & Say).Interior.ColorIndex = 6
End If
End If
'--C---------------------I
If Cells(Say, "I").Value = "C" Or Cells(Say, "I").Value = "c" Then
If Cells(1, "AQ").Value < 100 Then
Cells(Say, "S").Value = CDate(Date) + 0.625
Range("I" & Say & ":t" & Say).Interior.ColorIndex = 7
Else
Cells(Say, "S").Value = Cells(1, "AQ").Value
Range("I" & Say & ":t" & Say).Interior.ColorIndex = 7
End If
End If
'--D---------------------I
If Cells(Say, "I").Value = "D" Or Cells(Say, "I").Value = "d" Then
If Cells(1, "AU").Value < 100 Then
Cells(Say, "S").Value = CDate(Date) + 0.625
Range("I" & Say & ":t" & Say).Interior.ColorIndex = 8
Else
Cells(Say, "S").Value = Cells(1, "AU").Value
Range("I" & Say & ":t" & Say).Interior.ColorIndex = 8
End If
End If
Cells(Say, "t").Value = Cells(Say, "S").Value + Cells(Say, "r").Value
ATLA:
'------V SÜTUNU----------
If Cells(Say, "V").Value = "" Then
Cells(Say, "AF").Value = ""
Range("V" & Say & ":AG" & Say).Interior.ColorIndex = xlNone
GoTo ATLA1
End If
Call HESAPLA2
'--A---------------------V
If Cells(Say, "V").Value = "A" Or Cells(Say, "V").Value = "a" Then
If Cells(1, "AM").Value < 100 Then
Cells(Say, "AF").Value = CDate(Date) + 0.625
Range("V" & Say & ":AG" & Say).Interior.ColorIndex = 4
Else
Cells(Say, "AF").Value = Cells(1, "AM").Value
Range("V" & Say & ":AG" & Say).Interior.ColorIndex = 4
End If
End If
'--B---------------------V
If Cells(Say, "V").Value = "B" Or Cells(Say, "V").Value = "b" Then
If Cells(1, "AO").Value < 100 Then
Cells(Say, "AF").Value = CDate(Date) + 0.625
Range("V" & Say & ":AG" & Say).Interior.ColorIndex = 6
Else
Cells(Say, "AF").Value = Cells(1, "AO").Value
Range("V" & Say & ":AG" & Say).Interior.ColorIndex = 6
End If
End If
'--C---------------------V
If Cells(Say, "V").Value = "C" Or Cells(Say, "V").Value = "c" Then
If Cells(1, "AQ").Value < 100 Then
Cells(Say, "AF").Value = CDate(Date) + 0.625
Range("V" & Say & ":AG" & Say).Interior.ColorIndex = 7
Else
Cells(Say, "AF").Value = Cells(1, "AQ").Value
Range("V" & Say & ":AG" & Say).Interior.ColorIndex = 7
End If
End If
'--D---------------------V
If Cells(Say, "V").Value = "D" Or Cells(Say, "V").Value = "d" Then
If Cells(1, "AU").Value < 100 Then
Cells(Say, "AF").Value = CDate(Date) + 0.625
Range("V" & Say & ":AG" & Say).Interior.ColorIndex = 8
Else
Cells(Say, "AF").Value = Cells(1, "AU").Value
Range("V" & Say & ":AG" & Say).Interior.ColorIndex = 8
End If
End If
Cells(Say, "ag").Value = Cells(Say, "af").Value + Cells(Say, "ae").Value
ATLA1:
Next

End Sub

buda hesaplama kodları:

Kod: 
Sub HESAPLA2()
'On Error Resume Next
Columns("ca").Clear
Columns("cb").Clear
Columns("cc").Clear
Columns("cD").Clear
son = Sheets("Plan").Range("AS1").Value
For i = 2 To son
If Cells(i, "I").Value = "A" Or Cells(i, "I").Value = "a" Then
SN = Sheets("Plan").Range("CA65536").End(xlUp).Row + 1
Cells(SN, "CA").Value = Cells(i, "t").Value
End If
If Cells(i, "I").Value = "B" Or Cells(i, "I").Value = "b" Then
SN = Sheets("Plan").Range("CB65536").End(xlUp).Row + 1
Cells(SN, "CB").Value = Cells(i, "t").Value
End If
If Cells(i, "I").Value = "C" Or Cells(i, "I").Value = "c" Then
SN = Sheets("Plan").Range("CC65536").End(xlUp).Row + 1
Cells(SN, "CC").Value = Cells(i, "t").Value
End If
If Cells(i, "I").Value = "D" Or Cells(i, "I").Value = "d" Then
SN = Sheets("Plan").Range("CD65536").End(xlUp).Row + 1
Cells(SN, "CD").Value = Cells(i, "t").Value
End If
If Cells(i, "v").Value = "A" Or Cells(i, "v").Value = "a" Then
SN = Sheets("Plan").Range("CA65536").End(xlUp).Row + 1
Cells(SN, "CA").Value = Cells(i, "ag").Value
End If
If Cells(i, "v").Value = "B" Or Cells(i, "v").Value = "b" Then
SN = Sheets("Plan").Range("CB65536").End(xlUp).Row + 1
Cells(SN, "CB").Value = Cells(i, "ag").Value
End If
If Cells(i, "v").Value = "C" Or Cells(i, "v").Value = "c" Then
SN = Sheets("Plan").Range("CC65536").End(xlUp).Row + 1
Cells(SN, "CC").Value = Cells(i, "ag").Value
End If
If Cells(i, "v").Value = "D" Or Cells(i, "v").Value = "d" Then
SN = Sheets("Plan").Range("CD65536").End(xlUp).Row + 1
Cells(SN, "CD").Value = Cells(i, "ag").Value
End If
Next
Cells(1, "AM").Value = WorksheetFunction.Max(Range("CA1:CA65536"))
Cells(1, "AO").Value = WorksheetFunction.Max(Range("CB1:CB65536"))
Cells(1, "AQ").Value = WorksheetFunction.Max(Range("CC1:CC65536"))
Cells(1, "AU").Value = WorksheetFunction.Max(Range("CD1:CD65536"))
End Sub

Deneyin umarım olmuştur.
 

Ekli dosyalar

Son düzenleme:
Harikasınız..evet olmuş...Allah razı olsun, Sistemde mantık tamamen oturmuş durumda...Elinize sağlık...
 
Şu anda tekrar güncelledim sayfayı toplama formüllerindende kurtardım.
 
Çok teşekkürler,,
mükemmel oldu...sistemin dahada esnek olması için şöyle bir şey yapmak istiyorum.
0,625 saat 15:00 'a denk geliyor (1'lik sistemde) ama diyelim saat 15:00 değilde saat 10:00 yapmaya kalksam kodlarda 0,625 değiştirmem gerekiyor.Bu 0,625 değerini sayfada bir hücreye monte etmek ve hücre değeri değiştikçe sistem taramasının değişmesini sağlamak istiyorum.
Teşekkürler
 
Harika...Çok teşekkürler...
Sn.Fedeal ,sizinde inşallah varsa eğer her türlü sıkıntı,problemi Rabbim izale etsin inş.
 
Barons' Alıntı:
Harika...Çok teşekkürler...
Sn.Fedeal ,sizinde inşallah varsa eğer her türlü sıkıntı,problemi Rabbim izale etsin inş.
Genişletmek için tıkla ...

Bu gün iyi dualar alıyorum.Cümlemizin inşallah saygılar.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst