(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.
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.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
Sayın @atoykan hocam kodu denedim ama bazı yerlerde hata veriyor. Örneğin 823 boş olması gerekir listede yok.
yyhy, 18-05-2009 tarihinden beri AccessTr.neT üyesidir.
