Araç Km Tahmin

[gurbuzs]

Servise gelen araçlar var. bunlar birkaç defa gelen araçlar. bunların yıllık ve aylık kaç km yaptıklarını tahmin edeceğiz ve bir sonraki servise mesela 10bin km sonra hangi tarihte geleceğini tahmin etme konusunda yardıma ihtiyaç var.
Servise 1 defa geldiyse nasıl tahmin edilir onu da bilemedim

 

[HücrelereFısıldayanAdam]

Her plakanın, ilk servis (ÇOKEĞERMİN) ve son servis tarihleri (ÇOKEĞERMAK) arasındaki gün hesaplanacak.
Bu sayı toplam o plakanin servise gelme sayısı -1'e bölünecek.
Sonra bulunan bu gün sayısı, her plakanın son servis tarihine eklenecek.

ÇOKEĞERSAY kullanmanız gerek, bir de tarihlerin güne çevrilerek hesaplanması gerekir.

Servise 1 defa geldiyse, bir tahmin yapılamaz.

 

[Muzaffer Ali]

Merhaba.

Dosyanız ekte inceleyiniz.

Sadece bir defa servise gelmiş olan araç için bir sonraki servis tarihine 365 gün eklenmiştir. Diğerlerinin önceki servis aralıklarının ortalaması alınmıştır.

 

[gurbuzs]

Merhaba.

Dosyanız ekte inceleyiniz.

Sadece bir defa servise gelmiş olan araç için bir sonraki servis tarihine 365 gün eklenmiştir. Diğerlerinin önceki servis aralıklarının ortalaması alınmıştır.

Sanırım bi hata var. mesela 06YY2222 plakalı araç yaklaşık 11 ayda 10bin km yapmış. ama tahminde 4 ay sonra bakıma gelecek görünüyor.
35ZZ3333 için de aynı durum var

 

[Muzaffer Ali]

Kodları aşağıdakilerle değiştirin.

Private Sub btnTahmin_Click()
    Dim Bak As Long
    Dim Plaka As Range
    Dim Ortalama() As Double
    Dim IlkAdres As String
    Dim Tarih As Date
    Dim Say As Integer
    ReDim Ortalama(0)
    For Bak = 2 To Cells(Rows.Count, "I").End(xlUp).Row
        With Range("C:C")
            Set Plaka = .Find(What:=Cells(Bak, "I").Value, LookAt:=xlWhole)
            IlkAdres = Plaka.Address
            If Not Plaka Is Nothing Then
                Tarih = Cells(Plaka.Row, "B")

                Do
                    Set Plaka = .FindNext(Plaka)
                    If IlkAdres = Plaka.Address Then Exit Do
                    ReDim Preserve Ortalama(Say)
                    Ortalama(UBound(Ortalama)) = Cells(Plaka.Row, "B") - Tarih
                    Tarih = Cells(Plaka.Row, "B")
                    Say = Say + 1
                Loop While Not Plaka Is Nothing
            End If
        End With
        If Ortalama(0) = 0 Then
            Cells(Bak, "J").Value = DateAdd("d", 365, Tarih)
        Else
            Cells(Bak, "J").Value = DateAdd("d", WorksheetFunction.Average(Ortalama), Tarih)
        End If
        Say = 0
        ReDim Ortalama(Say)
    Next
    MsgBox "Tamamlandı"
End Sub

 

[gurbuzs]

Kodları aşağıdakilerle değiştirin.

Private Sub btnTahmin_Click()
    Dim Bak As Long
    Dim Plaka As Range
    Dim Ortalama() As Double
    Dim IlkAdres As String
    Dim Tarih As Date
    Dim Say As Integer
    ReDim Ortalama(0)
    For Bak = 2 To Cells(Rows.Count, "I").End(xlUp).Row
        With Range("C:C")
            Set Plaka = .Find(What:=Cells(Bak, "I").Value, LookAt:=xlWhole)
            IlkAdres = Plaka.Address
            If Not Plaka Is Nothing Then
                Tarih = Cells(Plaka.Row, "B")

                Do
                    Set Plaka = .FindNext(Plaka)
                    If IlkAdres = Plaka.Address Then Exit Do
                    ReDim Preserve Ortalama(Say)
                    Ortalama(UBound(Ortalama)) = Cells(Plaka.Row, "B") - Tarih
                    Tarih = Cells(Plaka.Row, "B")
                    Say = Say + 1
                Loop While Not Plaka Is Nothing
            End If
        End With
        If Ortalama(0) = 0 Then
            Cells(Bak, "J").Value = DateAdd("d", 365, Tarih)
        Else
            Cells(Bak, "J").Value = DateAdd("d", WorksheetFunction.Average(Ortalama), Tarih)
        End If
        Say = 0
        ReDim Ortalama(Say)
    Next
    MsgBox "Tamamlandı"
End Sub

şimdi oldu ....
teşekkürler