Otomatik tamamlama

[vetvural]

Selamun aleykum arkadaşlar benim sorunum şu hayvanlar in kulak kupesi Tr02000012345 13 haneli ben 12345 yazdigimda onu otomatik olarak 13 haneli olan Tr02000012345 çevirsin ben biçim olarak geçirebildim ama kopyala yada formüle aktarınca 12345 olarak goruyor

 

[mrwarrior]

=BİRLEŞTİR("TR020000"&A1)

Şeklinde olabilir.

 

[Tevfik_Kursun]

Merhaba,
Sadece

="TR020000"&A1

bile işini görür.
İyi çalışmalar

 

[YUSUF44]

Aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırdığınızda A sütununa sayı girdiğinizde 02 plakalı küpe numarası şekline dönüştürür. Sizin numara gireceğiniz yer A sütunundan farklıysa gireceğiniz hücrelere göre kodda düzenleme yapılabilir:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Target <> "" Then
    If IsNumeric(Target) = True Then
        If Len(Target) > 9 Then
            MsgBox "Küpe numarası 13 karakterden uzun olamaz", vbCritical
            Target = ""
            Target.Select
        Else
            Target = "TR02" & WorksheetFunction.Rept("0", 9 - Len(Target)) & Target
        End If
    End If
End If
Application.EnableEvents = True
End Sub

 

[vetvural]

öyle oluyor ama ben bazen 5 haneli bazen 6 haneli bazen 7 haneli küpe yazıyorum düzeltme zaman alıyor

 

[YUSUF44]

Benim çözümümü denediniz mi?

 

[vetvural]

Aşağıdaki kodları ilgili sayfanın kod bölümüne yapıştırdığınızda A sütununa sayı girdiğinizde 02 plakalı küpe numarası şekline dönüştürür. Sizin numara gireceğiniz yer A sütunundan farklıysa gireceğiniz hücrelere göre kodda düzenleme yapılabilir:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
Application.EnableEvents = False
If Target <> "" Then
    If IsNumeric(Target) = True Then
        If Len(Target) > 9 Then
            MsgBox "Küpe numarası 13 karakterden uzun olamaz", vbCritical
            Target = ""
            Target.Select
        Else
            Target = "TR02" & WorksheetFunction.Rept("0", 9 - Len(Target)) & Target
        End If
    End If
End If
Application.EnableEvents = True
End Sub

maalesef excel bilgim bu olaya yetmedi arkadaşlarla denemeye çalıştık olmadı bu dediğiniz dosya ek olarak epostayla gönderebilirmisiniz vetvural@hotmail.com

 

[YUSUF44]

Kodları kopyalayın
Excel dosyanızda sayfa adına sağ tıklayıp Kod görüntüle deyin
Çıkan sayfaya bu kodları yapıştırın
Excele geçin ve A sütununa küpe numarası girerek deneme yapın.
Eğer sayı girmezseniz işlem yapmaz.
Sayı girerseniz ve girdiğiniz sayı 9 basamaktan uzunsa uyarı verir
9 ve daha az basamaklı sayı girdiğinizde TR02........ şeklinde küpe numarasına dönüştürür.
Önceki mesajımda da belirttiğim gibi bu işlemin A sütununda değil de belirli başka bir yerde olmasını istiyorsanız o hücre adresine göre kod değiştirilmelidir.

 

[vetvural]

Harika çok teşekkür ederim yusuf44 hemide çook
allah razı olsun
allah bilgini artırsın

 

[vetvural]

Selamun aleykum yusuf44 kardeşim çözümünüz işe yarıyor ama a sutuna önceden yazdığım rakamları toplu kopyalayınca veya silmek için hücrenin köşesindeki artıyı aşşağı yukarı çekince hata veriyor ve çalışmayı durduruyor

 

[YUSUF44]

Aleykümselam.

Aşağıdaki gibi dener misiniz? Kırmızı olarak belirttiğim satır hata durumunda sonraki aşamaya geçmeyi sağlıyor.

Mavi olarak belirttiğim ile satır makro kodlarını geçici süreliğine pasifliyor, ikinci mavi satır ise tekrar aktifleştiriyor. Eğer makro çalışırken ilk mavi satırdan sonra hata verip durduysa pasifleme işlemi sabit kalmış olur ve daha sonra makro çalışmaz. Tekrar çalıştırabilmek için aşağıda aktif olarak belirttiğim makroyu bir defalığına çalıştırmanız gerekmektedir:

Private Sub Worksheet_Change(ByVal Target As Range)
[COLOR="Red"][B]On Error Resume Next[/B][/COLOR]
If Intersect(Target, [A:A]) Is Nothing Then Exit Sub
[COLOR="Blue"][B]Application.EnableEvents = False[/B][/COLOR]
If Target <> "" Then
    If IsNumeric(Target) = True Then
        If Len(Target) > 9 Then
            MsgBox "Küpe numarası 13 karakterden uzun olamaz", vbCritical
            Target = ""
            Target.Select
        Else
            Target = "TR02" & WorksheetFunction.Rept("0", 9 - Len(Target)) & Target
        End If
    End If
End If
[COLOR="blue"][B]Application.EnableEvents = True
[/B][/COLOR]End Sub

Sub aktif()
Application.EnableEvents = True
End Sub