Skip to main content

AccessTr.neT

Kayıt Ol

 | Facebook ile Bağlan  | Twitter İle Bağlan | Google+ İle Bağlan

Araç Plakalarından Boşta Olanları Bulma

yyhy
yyhy
Excel Cevaplanmış Soruları
19
624

Araç Plakalarından Boşta Olanları Bulma

Çözüldü #1
yyhy
Aktif Üye
yyhy
Bul
Aktif Üye
Adı Soyadı: Yı.... YI....
Konum: Konya
Ofis Versiyonu: Ofis 2019 64 Bit
Son Oturumu: 27/04/2024,20:52
Yorumları: 308
Konuları: 63
Kayıt Tarihi: 18/05/2009
Teşekkür Puanı: 0
Mesleğiniz: Serbest
Araç plakalarından boşta olanları bulmak istiyorum. Şöyle ki; 99 la başlayan (il yok ama) ilin AL serisi 001 den başlayıp 999 ile bitmektedir.
Zamanla sıradan verilen plakalar trafik sisteminden bir şekilde düşürülmüş ( Araçlar hurdaya çıkarılmış vs. ). Dosyada verilen plakalardan hangi seriler düşürülmüş bunları listelemek istiyorum.
.7z Verilen Verilmeyen Plakalar Listesi 2024 - 01.7z (Dosya Boyutu: 27,2 KB | İndirme Sayısı: 13)
yyhy, 18-05-2009 tarihinden beri AccessTr.neT üyesidir.
Cevapla
#2
atoykan
Uzman
atoykan
Bul
Uzman
Adı Soyadı:
Konum: İstanbul
Ofis Versiyonu: Ofis 2019 64 Bit
Son Oturumu: Dün,23:08
Yorumları: 1.279
Konuları: 3
Kayıt Tarihi: 23/02/2020
Teşekkür Puanı: 162
Mesleğiniz: CIO, Yazılım
Bu tip işlemleri Vba ile pratik bir şekilde çözmek varken neden ısrarla formül ile yapmaya çalışıyorsunuz halen anlamış değilim.
Kod:
=+EĞER(EĞERHATA(DÜŞEYARA("99AL"&C3;$D$3:$D$1001;1;0);YANLIŞ)<>YANLIŞ;"";"99AL"&C3)
formülünü deneyin. Formül C hücresindeki verinizi, "99AL" öntakısı ile D3 : D1001 aralığında arar ve mevcut ise hücreyi boş bırakır, değer olarak aralıkta yoksa eksik plaka numaranız olarak yazar, aradaki boş hücreleri filtrelemeniz icap eder.
Cevapla
#3
yyhy
Aktif Üye
yyhy
Bul
Aktif Üye
Adı Soyadı: Yı.... YI....
Konum: Konya
Ofis Versiyonu: Ofis 2019 64 Bit
Son Oturumu: 27/04/2024,20:52
Yorumları: 308
Konuları: 63
Kayıt Tarihi: 18/05/2009
Teşekkür Puanı: 0
Mesleğiniz: Serbest
Sayın @atoykan formül sorunsuz bir şekilde çalışıyor.
VBA ile çözümde çalışma sayfası daha rahat çalışıyor kasma işlemi falan olmuyor. Ancak son kullanıcı ben olmadığım için en azından formülü görerek düzeltme yönüne gidebilir diye düşünüyorum.
Bu haliyle Vba ne yazılabilir eğer ekleyebilirseniz alternatif olur. Bu şekliyle de işimi görmektedir hocam.
Emeğinize sağlık kolay gelsin.
yyhy, 18-05-2009 tarihinden beri AccessTr.neT üyesidir.
Cevapla
#4
atoykan
Uzman
atoykan
Bul
Uzman
Adı Soyadı:
Konum: İstanbul
Ofis Versiyonu: Ofis 2019 64 Bit
Son Oturumu: Dün,23:08
Yorumları: 1.279
Konuları: 3
Kayıt Tarihi: 23/02/2020
Teşekkür Puanı: 162
Mesleğiniz: CIO, Yazılım
Mantığını anlamanız için en basit hali kodlanmış ekli şöyle olur:
Kod:
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

    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:D").Find(What:="99AL" & 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 = "99AL" & 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, "99AL") > 0 Then
            ws.Cells(i, 3).Value = Format(Mid(SeriNo, 5), "000")
        End If
    Next i

    MsgBox "İşlem tamamlandı!", vbInformation
End Sub
bunu bir modüle ekleyip çalıştırdığınızda seri-999 içindeki değerleri plaka sütununda arar olmayanları verilmeyenler sütununda listeler. Belirttiğim üzere arama, bulma mantığını anlamanız açısından en basit şekli ile kodlanmıştır, dictionary gibi yapılar kullanılarak daha efektif kodlama yapılabilir.
Cevapla
#5
feraz
Uzman
feraz
Bul
Uzman
Adı Soyadı: Za....
Yaşı: 47
Konum: -
Ofis Versiyonu: Diğer
Son Oturumu: Dün,17:38
Yorumları: 3.637
Konuları: 95
Kayıt Tarihi: 30/03/2013
Teşekkür Puanı: 316
Kod:
Sub verilmeyenler()
    Dim i As Long, son As Long, kelime As String, kelime2 As String
    
    With ThisWorkbook.Worksheets("Sayfa1")
        .Range("E3:E" & Rows.Count).ClearContents
        son = .Range("C" & Rows.Count).End(3).Row
        If son < 3 Then GoTo 1
        Application.ScreenUpdating = False
        For i = 3 To son
            kelime = CStr(.Cells(i, "C").Value)
            kelime2 = "99AL" & kelime
            If WorksheetFunction.CountIf(.Range("D3:D" & i), kelime2) > 0 Then
                .Cells(i, "E").Value = ""
            Else
                .Cells(i, "E").Value = kelime2
            End If
        Next
    End With
1
    Application.ScreenUpdating = True
End Sub
Cevapla
#6
feraz
Uzman
feraz
Bul
Uzman
Adı Soyadı: Za....
Yaşı: 47
Konum: -
Ofis Versiyonu: Diğer
Son Oturumu: Dün,17:38
Yorumları: 3.637
Konuları: 95
Kayıt Tarihi: 30/03/2013
Teşekkür Puanı: 316
Yada

PHP Kod:
Sub verilmeyenler()
    Dim i As Long, son As Long, kelime As String, kelime2 As String
    Dim plaka As String
    
    With ThisWorkbook.Worksheets("Sayfa1")
        .Range("E3:E" & Rows.Count).ClearContents
        son = .Range("C" & Rows.Count).End(3).Row
        If son < 3 Then GoTo 1
        Application.ScreenUpdating = False
        For i = 3 To son
            plaka = .Cells(i, "D").Value
            If Trim(plaka) <> "" Then
                kelime = CStr(.Cells(i, "C").Value)
                kelime2 = Mid(plaka, 1, Len(plaka) - 3) & kelime
                If WorksheetFunction.CountIf(.Range("D3:D" & i), kelime2) > 0 Then
                    .Cells(i, "E").Value = ""
                Else
                    .Cells(i, "E").Value = kelime2
                End If
            End If
        Next
    End With
1
    Application.ScreenUpdating = True
End Sub 
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task