Nakil sekillendirmesi

[boss2090]

Merhaba Arkadaslar,

Ben mallarin nezaman nakledileceklerinin listesini olusturmak istiyorum.

Söyleki mesala:
1) T-Seklindeki bir demir 12.02.2012 ve 16.02.2012 de nakledilecek buna göre M11 den Q11 e kadar sari renk olacak. Tarihlere bagimli olacak yani 12.02.2012 degilde 01.02.2012 olursa B11 den Q11 e kadar sari renk olacak.

2) Ayni sey Alimunyum icin 06.02.2012 de ve 21.02.2012 nakil olacak

3) Civata 02.02.2012 ve 17.02.2012 de nakil olacak.

Ben Office 2007 kullaniyorum.

Bir örnek ekte ekliyorum. Yardiminiz icin simdiden tesekkürler.
Devaminda bir sorum olacak ama ilk bunu cözmeme gerekiyor.

 

[mancubus]

A2:A4'teki 3 ürüne göre ve ürün bilgisinin bire bir aynı olarak A11:A13'te aranması esasına göre hazırlanmıştır.

birleştirilmiş hücreler iptal edilmiş ancak o şekilde görünmeleri sağlanmıştır.

10. satırdaki rakamların yerine "gg" formatında tarih bilgisi girilmiştir.
bulma işleminin sağlığı açısından diğer aylarda da aynı şekilde yapılmalıdır.

bu nedenle dosya da ayrıca eklenmiştir.

Option Explicit

Sub TarihBulBoya()

    Dim mlzCell As Range, ilkCell As Range, sonCell As Range
    Dim mlz As String, ilkTarih As String, sonTarih As String
    Dim i As Long, sat As Long, ilkSut As Long, sonSut As Long
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
        .EnableEvents = False
    End With
    
    Range("B11:AF13").Interior.ColorIndex = xlNone
        
    For i = 2 To Range("A2").End(xlDown).Row
        mlz = Cells(i, "A").Value
        ilkTarih = Cells(i, "B").Value
        sonTarih = Cells(i, "F").Value
    
        On Error Resume Next
        Set mlzCell = Range("A11:A" & Range("A11").End(xlDown).Row).Find(What:=mlz, _
            After:=Range("A11"), LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, _
            SearchDirection:=xlNext, MatchCase:=False)
        Set ilkCell = Rows(10).Find(What:=CDate(ilkTarih), After:=Range("A10"), LookIn:=xlFormulas, _
            LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
        Set sonCell = Rows(10).Find(What:=CDate(sonTarih), After:=Range("A10"), LookIn:=xlFormulas, _
            LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
        On Error GoTo 0
        
        If mlzCell Is Nothing Or ilkCell Is Nothing Or sonCell Is Nothing Then
            MsgBox "Aranan " & i & " .satırdaki Malzeme: '" & mlz & "' / " & "İlk_Tarih: '" & ilkTarih & "' / " & "Son_Tarih: '" & sonTarih & "'" & vbCr & _
                "değerlerinden en az bir tanesi bulunamadı!" & vbCr & _
                "Malzeme isimlerinin A sütununda doğru yazıldığından emin olun!" & vbCr & _
                "Tarih bilgilerinin 10. satırda doğru ve aynı formatta olmasını sağlayın!", _
                vbOKOnly + vbCritical, "UYARI"
        Else
            sat = mlzCell.Row
            ilkSut = ilkCell.Column
            sonSut = sonCell.Column
            Range(Cells(sat, ilkSut), Cells(sat, sonSut)).Interior.ColorIndex = 6
        End If
    Next
    
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .EnableEvents = True
    End With

End Sub