İlçeye göre dosya no.sunda hata nereden kaynaklanmaktadır?

[mars2]

İyi Günler;
aşağıdaki kod ile D sutunda buluna hücrelere ilçenin adını yazdığımda B sutununda hizasına istediğim şekilde dosya no.su vermektedir. Ancak, 10 no.lu dosyalara gelince (Örnek : 35033561010 vermesi gerekirken 350335610010 vermekte) 010 vereceğine 0010 vermekte(her onluk sayıda aynı hatayı vermekte 020 0020 gibi) koddaki hata nereden kaynaklanmakdır.

Yeni dosya sayısı temel mantığı 11 rakamlı sayının ilk ikiş basamagı sabit yani 35'tir. bundan sonra gelen üçüncü ve dördüncü rakamlar ise ilçeler listesindeki ilçe hizasındaki iki basamaklı rakam (Buca 03 gibi) 5. 6. 7. ve 8. rakamlar sabit olup 3561 olacak, 9.10. ve 11 rakamlar ise ilçenin adına göre 001 başlayıp 999'na kadar devam edecektir.

Örnek dosya ektedir.

 

[mars2]

Kodu yazmayı unutmuşum,
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Local Error Resume Next
Dim bak As Range, a As Long, i As Long, s1 As Worksheet, s2 As Worksheet
If Target.Offset(0, -2).Value <> Empty Then End
Set s1 = Sheets("Liste")
Set s2 = Sheets("ilceler")
a = s1.Range("b65536").End(3).Row
i = s2.Range("b65536").End(3).Row
Select Case Target.Column
Case Is = "4"
If WorksheetFunction.CountIf(s1.Range("d1:d" & a), Target.Value) > 0 Then
For Each bak In s1.Range("d1:d" & a)
If bak.Value = Target.Value Then
sirabas = Mid(CStr(bak.Offset(0, -2).Value), 1, Len(CStr(bak.Offset(0, -2).Value)) - 1)
sirason = CInt(Mid(bak.Offset(0, -2).Value, Len(bak.Offset(0, -2).Value), 2)) + 1
sirano = CStr(sirabas & sirason)
End If
Next bak
Target.Offset(0, -2).Value = sirano
Else
deger = s2.Cells(s2.Range("a2:b" & i).Find(Target.Value).Row, 1).Value
If deger = Empty Then
Exit Sub
ElseIf Len(deger) = 1 Then
sirano = "350" & deger & "3561001"
ElseIf Len(deger) = 2 Then
sirano = deger & "3561001"
End If
Target.Offset(0, -2).Value = sirano
End If
End Select

End Sub