isteğe uyarlanmış

[tubitakexcel]

istediğim şey mesela 1,2,3,gibi rakamları TL01000000001 , TL01000000002, TL01000000003 çevirme
isteğe uyarlanmış özelliği ile hücreleri çeviriyorum ama formül yazınca formül hücreleri 1 ,2, 3 diye görüyor.
Bu rakamları otomatik ekleyen bir formül yazabilir miyiz?
yani formüle yazdığım rakamları TL01000000000 formatına çevirsin, otomatik tamamlasın yani
9 u TL01000000009 a
156 TL01000000156 ya
1453 ü TL01000001453 YA yani TL01 den sonra 9 karaktere tamamlamasına.
şimdiden herkese teşekkür ederim

 

[Korhan Ayhan]

Sayfanızın kod bölümüne uygulayınız.

"A" sütunundaki hücrelerde çalışır.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    If IsNumeric(Target) Then
        Select Case Len(Target)
            Case Is > 9
                MsgBox "Lütfen uygun uzunlukta veri girişi yapınız!", vbCritical
                Target.ClearContents
                Target.Select
                Exit Sub
            Case Else
                Target = "TL01" & Format(Target, "000000000")
        End Select
    Else
        MsgBox "Lütfen sayısal değer giriniz!", vbCritical
        Target.ClearContents
        Target.Select
    End If
    Application.EnableEvents = True
End Sub

 

[tubitakexcel]

çookk teşekkür ediyorum çalışıyor.
yalnız bir kısmı eksik kaldı
1, 2, 3, 9 , 8, 7, 4 ,5, karışık yazıyorum
bunları önce küçükten büyüğe
=KÜÇÜK($B$1:$B$1001;SATIR(D8))
diye sıralıyorum
sonra d2 deki veriyi a2 de göster deyince =d2 SAYISAL DEĞER girin diye hata veriyor.
bu koda birde büyükten küçüğe sıralayı ekleyebilirmiyiz size zahmet
son 9 rakama göre sıralasa
şimdiden teşekkürler

 

[Korhan Ayhan]

Sıralama için aşağıdaki şekilde deneyebilirsiniz.

Diğer bahsettiğiniz durumu anlayamadım. Dosya üzerinde açıklarsanız yardımcı olabilirim.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("A:A")) Is Nothing Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    Application.EnableEvents = False
    If IsNumeric(Target) Then
        Select Case Len(Target)
            Case Is > 9
                MsgBox "Lütfen uygun uzunlukta veri girişi yapınız!", vbCritical
                Target.ClearContents
                Target.Select
                Exit Sub
            Case Else
                Target = "TL01" & Format(Target, "000000000")
                Range("A:A").Sort Range("A1"), xlAscending, , , , , , xlNo
        End Select
    Else
        MsgBox "Lütfen sayısal değer giriniz!", vbCritical
        Target.ClearContents
        Target.Select
    End If
    Application.EnableEvents = True
End Sub