HÜCREDEKİ RAKAMLARI HARF KARŞILIKLARINA ÇEVİRME

[tatasoy]

HÜCREDEKÝ RAKAMLARI HARF KARÞILIKLARINA ÇEVÝRME

:hey:
EXCEL 2000 Türkçe kullanıcısıyım. Satış fiyat listesi hazırlıyorum. Alış tutarlarımı makro ile kullandıgım şifreye çevirmek istiyorum. Þöyle ki;
Her rakam karşısındaki harf degerini alacak şekilde,
a = 1
N = 2
A = 3
T = 4
S =5
E = 6
t = 7
K = 8
I = 9
Z = 0

örnegin 125 degerindeki hücreyi aNS haline dünüştürecek ve gerektiginde degeri rakama geri çevirecegim makroya ihtiyacım var.
Yardımlarınızı bekliyorum.

 

[Haluk]

Mrb;

Aşağıdakileri bir module olduğu gibi yapıştırın.

Daha sonra verinin olduğu hücreyi seçin ve aşağıdaki Encrypt veya Decrypt prosedurlerini çalıştırın.

Sub Encrypt()
    Dim Array1, Array2
    Dim MyVal As String
    Dim i As Integer
    Array1 = Array("a", "N", "b", "t", "S", "E", "T", "K", "I", "Z")
    Array2 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 0)
    MyVal = ActiveCell.Text
        For i = LBound(Array1) To UBound(Array1)
            MyVal = WorksheetFunction.Substitute(MyVal, Array1(i), Array2(i))
        Next
    ActiveCell = MyVal
End Sub
'
Sub Decrypt()
    Dim Array1, Array2
    Dim MyVal As String
    Dim i As Integer
    Array1 = Array("a", "N", "b", "t", "S", "E", "T", "K", "I", "Z")
    Array2 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 0)
    MyVal = ActiveCell.Text
        For i = LBound(Array1) To UBound(Array1)
            MyVal = WorksheetFunction.Substitute(MyVal, Array2(i), Array1(i))
        Next
    ActiveCell = MyVal
End Sub

 

[htsumer]

Büyük küçük harfe duyarsız olması için neyapabiliriz..

 

[Haluk]

Büyük küçük harfe duyarsız olması için neyapabiliriz..

Kodlardaki Array1(i) yerine LCase(Array1(i) kullanmayı dene.

 

[htsumer]

Sağolun.

 

[tatasoy]

öncelikle yardımınıza teşekkür ederim.

makro çalışıyor. Fakat sadece hücre için degilde tüm sütun için veya seçilmiş olan hücreler için makroyu nasıl çalıştırabilirim.

 

[Haluk]

Merhaba;

İlgili hücreleri seçtikten sonra;

Sub Encrypt2()
    Dim Array1, Array2
    Dim i As Integer
    Dim MyRng As Range
    Array1 = Array("a", "N", "b", "t", "S", "E", "T", "K", "I", "Z")
    Array2 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 0)
        For Each MyRng In Selection
            For i = LBound(Array1) To UBound(Array1)
                MyRng = WorksheetFunction.Substitute(MyRng, Array1(i), Array2(i))
            Next
        Next
End Sub
'
Sub Decrypt2()
    Dim Array1, Array2
    Dim i As Integer
    Dim MyRng As Range
    Array1 = Array("a", "N", "b", "t", "S", "E", "T", "K", "I", "Z")
    Array2 = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 0)
        For Each MyRng In Selection
            For i = LBound(Array1) To UBound(Array1)
                MyRng = WorksheetFunction.Substitute(MyRng, Array2(i), Array1(i))
            Next
        Next
End Sub