Destek Talep : Hücredeki veriyi random kısaltma

[sistemarjin]

Merhaba,

Harf ve Rakamlardan oluşan yaklaşık 5Bin satır civarı benzersiz 27 karakterli kod numaraları var.
Bunları belli bir kurala bağlı olarak yine sadece harf ve rakamlardan oluşan 8 ya da 10 karaktere kadar çevirip kısaltacak formul ya da fonksiyon arıyorum bulamadım.

Örnek:
AUDA3SSUNTY2329INCPFMXAND => XE5SWT3UL4
AUDA4SUNTY4649INCPNVMAN3 => ET5TQ5CK2P

Bu konuda fikri olan varsa ve paylaşırsa sevinirim.

Şimdiden teşekkürler

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kodu deneyiniz.
kodlar A kolonunda olmalı, yeni kodlar B kolonuna yazılacaktır.

Sub test()
    Dim Bak As Long
    Dim Kod As String
    Dim YKod As String
    Dim YKarakter As String
    Dim KSay As Integer
    Dim YenikodSayisi As Integer
    YenikodSayisi = 8
    For Bak = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        For BakKod = 1 To YenikodSayisi
            Kod = Cells(Bak, "A")
            KSay = Len(Kod)
            YKarakter = Right(Left(Kod, Int((KSay * Rnd) + 1)), 1)
            YKod = YKod & YKarakter
            Kod = Replace(Kod, YKarakter, "")
        Next
        Cells(Bak, "B") = YKod
        YKod = ""
    Next
End Sub

 

[sistemarjin]

Merhaba.
Aşağıdaki kodu deneyiniz.
kodlar A kolonunda olmalı, yeni kodlar B kolonuna yazılacaktır.

Sub test()
    Dim Bak As Long
    Dim Kod As String
    Dim YKod As String
    Dim YKarakter As String
    Dim KSay As Integer
    Dim YenikodSayisi As Integer
    YenikodSayisi = 8
    For Bak = 1 To Cells(Rows.Count, "A").End(xlUp).Row
        For BakKod = 1 To YenikodSayisi
            Kod = Cells(Bak, "A")
            KSay = Len(Kod)
            YKarakter = Right(Left(Kod, Int((KSay * Rnd) + 1)), 1)
            YKod = YKod & YKarakter
            Kod = Replace(Kod, YKarakter, "")
        Next
        Cells(Bak, "B") = YKod
        YKod = ""
    Next
End Sub

SÜPER ÖTESİ MÜKEMMEL!!!

TEŞEKKÜRLER