Bakım Planını tarihlere göre hazırlamak&güncellemek

[dost]

Merhaba,

1- Ne elde etmek istiyorsunuz detaylı anlatırsanız,
2- Elde etmek istediğiniz sonuçlardan örnek olması için farklı sütuna değer yazarsanız

@ÖmerFaruk, ben veya diğer üye arkadaşlar yardım edebilir diye düşünüyorum.

 

[ockucukay]

Merhaba,

Tekrar anlatayım.
Dosya bakım bölümüne ait. Haftalık listeye, gelecek hafta hangi tezgahlara bakım yapılacaksa listelemek istiyorlar. Yani şu anda 40.haftadayız, haftalık listeye 41.hafta bakım yapılacak tezgahlar gelecek. Haftalık liste sayfasındaki makro bu verileri "Makina Listesi" sayfasındaki verileri alarak yapıyordu. Bakım planında da aynı verileri (planlanan-gerçekleşen şeklinde) görebiliriz. Benim sorduğum kısım; dosyada (kod, format vb) herhangi bir değişiklik olmamasına rağmen makro artık düzgün çalışmıyor. Örnek olarak 41.haftayı seçiyorum. 20 adet tezgah gelmeli plana göre (16,314,315,365,366,367,368,369,370,371,372,373,413,415,416,419,420,421,422,423) ama kendi kafasına göre 38.haftadan 6 adet tezgah listeye getiriyor. Bunu çözemedim demiştim. Umarım derdimi anlatabilmişimdir.

Bu arada ben makroda farklı denemeler ile sorunu çözmeye çalışıyorum ama hala sonuca ulaşamadım

 

[dost]

Merhaba,

P5 hücresinden başlayarak haftayı bulan formülleri aşağıdaki formülle değiştirin.

=IF(O5="";"";WEEKNUM(O5;2))

Haftalık Bakım Listesi sayfasının Module'ne aşağıdaki kodu kopyalayınız.

Sub HAFTALIK_BAKIMLAR()

Dim c, lCol, rCount As Integer
Dim lRow As Long
Dim sh1, sh2 As Worksheet
Dim MyList, myRng, Rng As Range
Dim bTrh As Date

Set sh1 = ThisWorkbook.Sheets("MAKİNA LİSTESİ")
Set sh2 = ThisWorkbook.Sheets("Haftalık Bakım Listesi")
Set MyList = sh1.UsedRange

lCol = sh1.Cells(4, sh1.Columns.Count).End(xlToLeft).Column
If sh2.[A1] = "" Or sh2.[B1] = "" Then MsgBox "A1 hücresinden hafta seçimi yapınız..": Exit Sub
Application.ScreenUpdating = False

bTrh = DateSerial(sh2.[B1], 1, 1)
bTrh = (bTrh - Weekday(bTrh, 3)) + ((sh2.[A1] - 1) * 7)
sh2.[C1] = Format(bTrh, "dd.mm.yyyy") & " - " & Format(bTrh + 7, "dd.mm.yyyy") & _
    " HAFTASINDA YAPILACAK PERİYODİK BAKIM LİSTESİ"
sh2.[C1].Font.ColorIndex = xlAutomatic: sh2.[C1].Font.Size = 12
sh2.[C1].Characters(Start:=1, Length:=23).Font.Color = vbRed
sh2.[C1].Characters(Start:=1, Length:=23).Font.Size = 18
sh2.Range("A3:H" & sh2.Rows.Count).ClearContents
rCount = 2

With MyList
    For c = 16 To lCol Step 3
        .Parent.AutoFilterMode = False
        .Rows("4:4").AutoFilter
        .AutoFilter Field:=c, Criteria1:=sh2.Range("A1")
        lRow = sh1.Cells(sh1.Rows.Count, "A").End(xlUp).Row
        If lRow > 4 Then
            Set myRng = sh1.Range("A5:A" & lRow).SpecialCells(xlCellTypeVisible)
            For Each Rng In myRng
                rCount = rCount + 1
                sh2.Cells(rCount, "A") = rCount - 2
                sh2.Cells(rCount, "B") = Rng.Row & "-" & Rng
                sh2.Cells(rCount, "C") = Rng.Offset(0, 1) & "-" & Rng.Offset(0, 2)
                sh2.Cells(rCount, "D") = Rng.Offset(0, 13)
                sh2.Cells(rCount, "E") = (c - 13) / 3
                sh2.Cells(rCount, "F") = Rng.Offset(0, c - 2)
                sh2.Cells(rCount, "G") = DateAdd("m", Rng.Offset(0, 13), Rng.Offset(0, c - 2))
                sh2.Cells(rCount, "H") = ""  'bu hücreyi nereden aldığınızı anlayamadım !!!
            Next Rng
        End If
     Next c
     .Parent.AutoFilterMode = False
End With

If rCount  = 2 Then
    sh2.[C3] = Replace(sh2.[C1], "LİSTESİ", "YOK"): sh2.[C3].Font.Color = vbRed
Else
    sh2.Range("A3:H" & rCount + 2).HorizontalAlignment = xlCenter
    sh2.Range("C3:C" & rCount + 2).HorizontalAlignment = xlGeneral
    sh2.Range("A3:H" & rCount + 2).VerticalAlignment = xlCenter
    sh2.Rows("3:" & rCount + 2).RowHeight = 15
    sh2.Activate
End If

Set sh1 = Nothing:  Set sh2 = Nothing:  Set MyList = Nothing

Application.ScreenUpdating = True

End Sub