(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").Find(What:=PlakaGrubu & PlakaHarfGrubu & SeriNo, LookIn:=xlValues, LookAt:=xlWhole)



        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.