Araç Plakalarından Boşta Olanları Bulma

(09/03/2024, 22:05)yyhy yazdı:

(05/03/2024, 23:24)atoykan yazdı: Plakadan bahsediyorsunuz. Plaka il kodu,tek harf, 3-4-5 rakam da olabilir, 2 harf , 3 harf de vs. Plaka ile ilgili her opsiyonu düşünmeniz gerekmez mi?

Hocam şöyle izah edersek örneğin 42 AA burası 001 ile başlayıp 42AA001 - 42 AA dan 999 olarak düşünüyoruz.
Yani 999 adet plaka verilmektedir.
42AA olan kısım bu seride sabit ve gözardı edebiliriz. Bize son kısım rakam gurubu burası şimdilik 3 haneli ### format bu olacak.
(şöyle ki: 42AA001,42AA002,............42AA999 da son bulacak. İlerleyen zamanlarda aradan boşa çıkan plakaları bulmak istiyoruz.)
Verilmeyen aradaki sayıları bulacak. Sayfada bir hücreye 42AA ibaresini veya başka yazabileceğimiz 42XX İbarelerini yazdığımızda o hücreyi referans göstererek (makro içinde olmaz ise daha iyi olacak.) bize verilmeyen listeyi oluştursun istiyoruz.

---

(09/03/2024, 11:37)atoykan yazdı: Kodu aşağıdaki gibi güncelleyin.

Sub PlakaKontrol()

    Dim ws As Worksheet

    Dim LastRow As Long, i As Long

    Dim SeriNo As String, PlakaGrubu As String, PlakaHarfGrubu As String

    Dim Plaka As Range, Verilmeyenler As Range



    Set ws = ThisWorkbook.Sheets("Sayfa1") ' Çalışma sayfasını tanımla



    LastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row ' Son satırı bul



    For i = 3 To LastRow

        SeriNo = ws.Cells(i, 3).Value ' Seri-999 değerini al

        PlakaGrubu = Left(Cells(i, 4), 2) ' plaka il gurubunu belirler

        PlakaHarfGrubu = SadeceHarfler(Cells(i, 4)) ' plaka harf grubunu belirler

    

        ' Plaka sütununda "99AL" & serino'yu ara

        Set Plaka = ws.Columns("D


        If Plaka Is Nothing Then ' Eğer kayıt yoksa Verilmeyenler sütununa ekle

            If Verilmeyenler Is Nothing Then

                Set Verilmeyenler = ws.Cells(i, 3)

            Else

                Set Verilmeyenler = Union(Verilmeyenler, ws.Cells(i, 3))

            End If

            ws.Cells(i, 3).Value = PlakaGrubu & PlakaHarfGrubu & SeriNo

        End If

    Next i



    If Not Verilmeyenler Is Nothing Then ' Verilmeyen plakaları alt alta sırala

        Verilmeyenler.Copy ws.Cells(3, 5)

    End If



    For i = 3 To LastRow

        SeriNo = ws.Cells(i, 3).Value

        PlakaGrubu = Left(Cells(i, 4), 2)

        PlakaHarfGrubu = SadeceHarfler(Cells(i, 4))

        If InStr(SeriNo, PlakaGrubu & PlakaHarfGrubu) > 0 Then

            ws.Cells(i, 3).Value = Format(Mid(SeriNo, 5), "000")

        End If

    Next i



    MsgBox "İşlem tamamlandı!", vbInformation

End Sub



Function SadeceHarfler(str As String) As String

    Dim i As Integer

    Dim karakter As String, sonuc As String



    sonuc = ""



    For i = 1 To Len(str)

        karakter = Mid(str, i, 1)

        If (karakter Like "[A-Za-z]") Then

            sonuc = sonuc & karakter

        End If

    Next i



    SadeceHarfler = sonuc

End Function



Function SadeceSayiAl(str As String) As String

    Dim i As Integer

    Dim karakter As String, sonuc As String



    sonuc = ""



    For i = 1 To Len(str)

        karakter = Mid(str, i, 1)

        If (IsNumeric(karakter)) Then

            sonuc = sonuc & karakter

        End If

    Next i



    SadeceSayiAl = sonuc

End Function

kod önce il grubunu belirler, sonra harf grubunu belirleyerek plakaları arar böylece il ve harf grubu değişsede istediğiniz gibi verilmeyen plakaları listeler.

Sayın @atoykan hocam kodu denedim ama bazı yerlerde hata veriyor. Örneğin 823 boş olması gerekir listede yok.

(08/03/2024, 21:21)feraz yazdı: Alttaki gibi Trim ile yapabilirsiniz ama tam anlamadım nerde boşluk.

plaka = Trim(.Cells(i, "D").Value)

---

Yada 5.Mesajdaki yeri alttaki gibi deneyin.

kelime = Trim(CStr(.Cells(i, "C").Value))

(09/03/2024, 22:30)yyhy yazdı:

(08/03/2024, 21:21)feraz yazdı: Alttaki gibi Trim ile yapabilirsiniz ama tam anlamadım nerde boşluk.

plaka = Trim(.Cells(i, "D").Value)

---

Yada 5.Mesajdaki yeri alttaki gibi deneyin.

kelime = Trim(CStr(.Cells(i, "C").Value))

Sayın @feraz hocam iyi akşamlar,
Şöyle izah edersek elimizde bir seri var bu seriyi 42AA bir hücreyi referans olarak göstersek, bu hücre içeriği zamanla 42AAB olabilir.
ilk verilen 2 rakam 2 harfe göre yani 42AA (sabit/değişken) 001 ile başlayıp 42AA999 da bitmektedir.
Zamanla aradan boşa çıkan plakalar olmaktadır. Bize hali hazırda aktif olanların listesi verilmektedir.
Bu verilen listeden arada boşa çıkanları tespit etme ve listelemek istiyoruz. Bu boşta olanları yeni araç alanlara verebilmemiz için gerekli. Zaman kaybını önleme ve içerisinden plaka seçebilme olanağı sağlayacaktır.

Sub PlakaKontrol()

    Dim ws As Worksheet

    Dim LastRow As Long, i As Long

    Dim SeriNo As String

    Dim Plaka As Range, Verilmeyenler As Range



    Set ws = ThisWorkbook.Sheets("Sayfa1") ' Çalışma sayfasını tanımla

    LastRow = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row ' Son satırı bul

    strwhat = Left(Cells(3, 4), 4)

    



    For i = 3 To LastRow

        SeriNo = ws.Cells(i, 3).Value ' Seri-999 değerini al



        ' Plaka sütununda "99AL" & serino'yu ara

        Set Plaka = ws.Columns("D


        If Plaka Is Nothing Then ' Eğer kayıt yoksa Verilmeyenler sütununa ekle

            If Verilmeyenler Is Nothing Then

                Set Verilmeyenler = ws.Cells(i, 3)

            Else

                Set Verilmeyenler = Union(Verilmeyenler, ws.Cells(i, 3))

            End If

            ws.Cells(i, 3).Value = strwhat & SeriNo

        End If

    Next i



    If Not Verilmeyenler Is Nothing Then ' Verilmeyen plakaları alt alta sırala

        Verilmeyenler.Copy ws.Cells(3, 5)

    End If



    For i = 3 To LastRow

        SeriNo = ws.Cells(i, 3).Value

        If InStr(SeriNo, strwhat) > 0 Then

            ws.Cells(i, 3).Value = Format(Mid(SeriNo, 5), "000")

        End If

    Next i



    MsgBox "İşlem tamamlandı!", vbInformation

End Sub