Dosya nosundaki baştan 3 ncü ve 4 ncü sıradaki rakama isabet eden ilçe adını yazdırma

[mars2]

İyi Akşamlar;

Tablomun "B" sutununda dosya nosu bulunmaktadır. "C" sutunda ise ilçe adı yer alacak, ilçe yer adını dosya nosunun 3. ve 4 ncü rakama denk gelen rakamların bulunduğu ilçe adlarını yazdıracak makroya ihtiyacım oldu.


Örneğin:
B sutunu C sutunu
Dosya Nosu İlçe adı
06014562058 Akyurt


İlçe adlarını makroda tek tek belirleyebiliriz veya ikinci bir sayfada liste de yapabiliriz.
01 Akyurt
02 Altındağ
03 Ayaş
04 Bâlâ
05 Beypazarı
06 Çamlıdere.
07 Çankaya.
08 Çubuk gibi

Eğer B sutununda 4 rakam mevcut olsaydı aşağıdaki makro ile yapılabiliniyor.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 2 Then
Satirlar = "C" & Target.Row & ":C" & Target.Row
Select Case Target

Case " ": Range(Satirlar) = " "

Case "0601": Range(Satirlar) = "Akyurt"
Case "0602": Range(Satirlar) = "Altındağ"
End Select
End If
End Sub

 

[muhasebeciyiz]

İlçe kodları ayrı bir sayfada listeli olsun - Sayfa2 (veya adı “ILCELER”) oluşturun:

A (Kod)	B (İlçe)
01	Akyurt
02	Altındağ
03	Ayaş
04	Bâlâ
05	Beypazarı
06	Çamlıdere
07	Çankaya
08	Çubuk

Sonra, kodun olduğu sayfanın kod bölümüne (Sheet’in kod penceresine) şu makroyu yapıştırın:

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Cikis
    If Target.CountLarge > 1 Then GoTo Cikis
    If Target.Column <> 2 Then GoTo Cikis 'B sütunu

    Application.EnableEvents = False

    Dim dosyaNo As String, kod As String, ilce As Variant
    dosyaNo = CStr(Target.Value)

    If Len(dosyaNo) < 4 Then
        Cells(Target.Row, "C").Value = ""
        GoTo Cikis
    End If
   
    kod = Mid$(dosyaNo, 3, 2)  
    ilce = Application.VLookup(kod, Worksheets("ILCELER").Range("A:B"), 2, False)

    If IsError(ilce) Then
        Cells(Target.Row, "C").Value = ""  'bulunamazsa boş bırak
    Else
        Cells(Target.Row, "C").Value = ilce
    End If

Cikis:
    Application.EnableEvents = True
End Sub

Not: Liste sayfanızın adı “ILCELER” değilse, kodda Worksheets("ILCELER") kısmını kendi sayfa adınızla değiştirin.

İlçeler makronun içinde “tek tek” tanımlı - Bu da olur; sadece kod sayfada şöyle:

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Cikis
    If Target.CountLarge > 1 Then GoTo Cikis
    If Target.Column <> 2 Then GoTo Cikis 'B sütunu

    Application.EnableEvents = False

    Dim dosyaNo As String, kod As String
    dosyaNo = CStr(Target.Value)

    If Len(dosyaNo) < 4 Then
        Cells(Target.Row, "C").Value = ""
        GoTo Cikis
    End If

    kod = Mid$(dosyaNo, 3, 2) '3-4. karakter

    Select Case kod
        Case "01": Cells(Target.Row, "C").Value = "Akyurt"
        Case "02": Cells(Target.Row, "C").Value = "Altındağ"
        Case "03": Cells(Target.Row, "C").Value = "Ayaş"
        Case "04": Cells(Target.Row, "C").Value = "Bâlâ"
        Case "05": Cells(Target.Row, "C").Value = "Beypazarı"
        Case "06": Cells(Target.Row, "C").Value = "Çamlıdere"
        Case "07": Cells(Target.Row, "C").Value = "Çankaya"
        Case "08": Cells(Target.Row, "C").Value = "Çubuk"
        Case Else: Cells(Target.Row, "C").Value = ""
    End Select

Cikis:
    Application.EnableEvents = True
End Sub