• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Sezar Şifreleme sistemi.

Katılım
8 Haziran 2007
Mesajlar
21
Excel Vers. ve Dili
2007 tur
Sorum şu: Sezar Şifresi olarak bilinen şifreleme sistemi var. Sistem, alfabedeki harfleri belirlenen miktarda ileri atlatmak şeklinde çalışıyor. Yani, 3 atlatmaya karar verdiyseniz A yerine D yazıyorsunuz. Excelde bunu sistemleştirmek mümkünmü? Mesela 10X10 luk bir bulmaca tablosu gibi tablo oluştursak Sayfa 1deki tabloya gerçek metin girilse ve sayfa2'deki tabloda şifreli metin oluşsa. Atlatma miktarınıda sayfa3'de ayarlar diye bir yer oluştursak ve atlatma miktarını giriniz hücresine miktarı girdiğimizde atlatma gerçekleşse. Bu arada 29 harf olduğundan atlatma miktarı 29u geçtiğinde tekrar 1den başlasa yani mod 29'a göre.. Eğlenceli ama siz profesyoneller için zormu kolaymı bilemem..

Bir diğeride şifre bulmaca oyunu ile ilgili. Zamanında çözmüşsünüzdür belki. yine bulmaca gibi bir tablomuz var. her karenin üzerinde sırasıyla bir sayı yazar, 1,5,19,21 gibi. birde ipucu verirler. 1=c 5= S gibi. sonra siz bilinen harfleri yerine yazar ve bulmacanın geri kalanını çözersiniz. kod bulmaca olarak da geçiyor. Burada da excel marifetiyle otomatik bir sistem oluşturulabilir mi acaba? Yani ayarlar diye bir kısım oluşturup AdanZye harfler yazılıp, karşılarına temsil etmesini istediğiniz rakamları kendimiz gireceğiz. A=1 ile değilde bizim verdiğimiz değer ile örneğin A=22 olacak. ve diğer harfler aynı şekilde. Sonra başka bir sayfadaki bulmaca tablosuna açık metini girdiğimizde diğer sayfadaki tabloda harflerin yerini bizim belirlediğimiz rakamlar alacak. Gibi.. çok mu oldum? Kusura bakmayın amacaım öğrencilermizi hem eğlndirmek hemde düşünce becerilerini hareketlendirmek..
 
Merhaba,

Sorunuzun 1. bölümü için aşağıdaki kodları inceleyiniz.

A sütununda yazılanları B sütununda şifreler. Kaç karakter ötesini isterseniz Adt değişkenine istediğiniz değeri veriniz. Ben 3 olarak belirttim.

Farklı algoritmalar da üretilebilinir.

Kod:
Public Const Harfler = " .,:?/+-@=0123456789ABCÇDEFGĞHIİJKLMNOÖPQRSŞTUÜVWXYZ"
Sub Sifrele()
    
    Dim i       As Integer
    Dim j       As Integer
    Dim Uz      As Integer
    Dim Adt     As Integer
    Dim Poz     As Integer
    Dim Sozcuk  As String
    
   [B] Adt = 3
[/B]    
    Uz = Len(Harfler)
    
    For i = 1 To Cells(Rows.Count, "A").End(3).Row
        Sozcuk = ""
        For j = 1 To Len(Cells(i, "A"))
            Poz = InStr(1, Harfler, Mid(Cells(i, "A"), j, 1), vbTextCompare)
            Poz = Poz + Adt
            If Poz > Uz Then Poz = Uz Mod Poz
            Sozcuk = Sozcuk & Mid(Harfler, Poz, 1)
        Next j
        Cells(i, "B") = Sozcuk
    Next i
    
End Sub
 

Ekli dosyalar

Necdet Bey çok güzel makro hazırlamış. İlave olarak adt değişkenini yani atlatma sayısını sayfadaki bir hücreden örneğin C1 hücresinden almak istiyorsanız adt=3 kısmını adt =[c1] yapabilir; ya da adt=inputbox("Atlatma sayısını giriniz") şeklinde mesaj kutusu çıkarttırıp istediğiniz sayıyı girerek de yapabilirsiniz.
 
Teşekkür ederim. Yalnız bir kısımda düzeltme gerekiyor sanırım zira şifrelenmiş metin sadece karakterlerden oluşsun istiyoruz. Yani z den sonra tekrar a ya dönmesi gerekiyor. mod 29 dan kastım oydu.
 
Hımm..
Public Const Harfler = "ABCÇDEFGĞHIİJKLMNOÖPQRSŞTUÜVWXYZABCÇDEFGĞHIİJKLMNOÖPQRSŞTUÜVWXYZ"
bu şekilde düzeltince oldu. Teşekkür ederim.

peki ikinci soru için öneriniz var mı
 
Hımm..
Public Const Harfler = "ABCÇDEFGĞHIİJKLMNOÖPQRSŞTUÜVWXYZABCÇDEFGĞHIİJKLMNOÖPQRSŞTUÜVWXYZ"
bu şekilde düzeltince oldu. Teşekkür ederim.

peki ikinci soru için öneriniz var mı

Bu kısmını özellikle açıklamamıştım, sonunda çözdünüz, tebrikler.

Sorunun ikinci kısmı için örnek basit bir dosya eklerseniz, daha açıklayıcı olacaktır.
 
Yalnız dikkatimi çekti, Necdet Bey'in kodlarında Z harfini atlatma kaç olursa olsun Z olarak şifreliyor, ayrıca atlatma sayısına göre harfin şifresi Z'den sonra başa dönmesi gereken bir şifre olduğunda onları da Z olarak şifreliyor. Ben şöyle bir değişiklik yaptım, inceler misiniz? Necdet Bey de yorumlarsa sevinirim:

Sadece alfabe için:

Kod:
Option Explicit
Public Const Harfler = "ABCÇDEFGĞHIİJKLMNOÖPQRSŞTUÜVWXYZ"

Sub Sifrele2()
    
    Dim i       As Integer
    Dim j       As Integer
    Dim Uz      As Integer
    Dim Adt     As Integer
    Dim Poz     As Integer
    Dim Sozcuk  As String
    
    Adt = InputBox("Atlatma sayısını giriniz")
    
    Uz = Len(Harfler)
    
    For i = 1 To Cells(Rows.Count, "A").End(3).Row
        Sozcuk = ""
        For j = 1 To Len(Cells(i, "A"))
            Poz = InStr(1, Harfler, Mid(Cells(i, "A"), j, 1), vbTextCompare)
            Poz = Poz + Adt
            If Poz > Uz Then Poz = Poz - Len(Harfler)
            Sozcuk = Sozcuk & Mid(Harfler, Poz, 1)
        Next j
        Cells(i, "B") = Sozcuk
    Next i
    
    [e1] = Len(Harfler)
End Sub

Daha çok karakter için:
Kod:
Option Explicit
Public Const Harfler = " .,:?/+-@=0123456789ABCÇDEFGĞHIİJKLMNOÖPQRSŞTUÜVWXYZ"

Sub Sifrele()
    
    Dim i       As Integer
    Dim j       As Integer
    Dim Uz      As Integer
    Dim Adt     As Integer
    Dim Poz     As Integer
    Dim Sozcuk  As String
    
    Adt = InputBox("Atlatma sayısını giriniz")
    
    Uz = Len(Harfler)
    
    For i = 1 To Cells(Rows.Count, "A").End(3).Row
        Sozcuk = ""
        For j = 1 To Len(Cells(i, "A"))
            Poz = InStr(1, Harfler, Mid(Cells(i, "A"), j, 1), vbTextCompare)
            Poz = Poz + Adt
            If Poz > Uz Then Poz = Poz - Len(Harfler)
            Sozcuk = Sozcuk & Mid(Harfler, Poz, 1)
        Next j
        Cells(i, "B") = Sozcuk
    Next i
    
    [e1] = Len(Harfler)
End Sub
 
Pardon, sorun farklı şekilde çözülmüş, benim yaptığım gibi olur mu?
 
Merhaba,

Aceleden yanlış yazmışım, tam olarak denemeyince de böyle olur tabi.

Kod:
If Poz > Uz Then Poz = Uz Mod Poz

yerine

Kod:
If Poz > Uz Then Poz = Poz Mod Uz

Olmalı.
 
Yapmak istediğim ekte.. Nejdet beyin gönderdiği makroları uyarlamayı denedim ama sanırım yapısal olarak değişik olduğundan ve bilgim daha fazlası için yetersiz olduğundan yapamadım
 

Ekli dosyalar

Son düzenleme:
Merhaba,

Örnek dosya ile soruyu sormak her zaman daha iyidir, gereksiz yazışmayı ortadan kaldırır.

Kod:
Public Const Harfler = "ABCÇDEFGĞHIİJKLMNOÖPQRSŞTUÜVWXYZ"
Sub Sifrele()
 
    Dim Hucre   As Range
    Dim Uz      As Integer
    Dim Adt     As Integer
    Dim Poz     As Integer
 
    Adt = Range("E12")
    Uz = Len(Harfler)
 
    Application.ScreenUpdating = False
 
    For Each Hucre In Range("B2:J10")
        If Not Hucre = "" Then
            Poz = InStr(1, Harfler, Hucre, vbTextCompare)
            Poz = Poz + Adt
            If Poz > Uz Then Poz = Poz - Len(Harfler)
            Hucre.Offset(0, 11) = Mid(Harfler, Poz, 1)
        Else
            Hucre.Offset(0, 11) = ""
        End If
 
    Next Hucre
 
    Application.ScreenUpdating = True
 
End Sub

İkinci soru için inceleyiniz.

Kod:
Sub SifreleR()
    
    Dim Hucre   As Range, _
        c       As Range
    
    Application.ScreenUpdating = False
    
    For Each Hucre In Range("B2:J10")
        Set c = Range("A12:AG12").Find(Hucre, LookIn:=xlValues)
        Hucre.Offset(0, 11) = c.Offset(1, 0)
    Next Hucre
    
    Application.ScreenUpdating = True
    
End Sub
 

Ekli dosyalar

Nejdet Bey çok teşekkür ederim. Daha iyisi olamazdı. Olsaydı onuda siz yapardınız sanırım. İyi çalışmalar, kolay gelsin diyorum.
 
Nejdet Bey çok teşekkür ederim. Daha iyisi olamazdı. Olsaydı onuda siz yapardınız sanırım. İyi çalışmalar, kolay gelsin diyorum.

Güle güle kullanınız, İşlemin tersini de siz yaparsınız umarım.

Not : Adımın için hiç "j" harfi yoktur.
 
Selamlar,
Benim de bir sorum olacak,
Örneğin 3 harf kaydırarak şifrelenen metni, başka bir sayfada yine A sütununa şifreli metni kopyalayarak bu sefer de 3 harf geri gelerek
B Sütununa çözebilir miyiz?
Ben biraz kodları oynadım ama tam bilgim olmadığı için başaramadım.
Teşekkürler..
 
Selam Necdet Bey,
Sizden yardım bekliyorum,
Teşekkürler...
 
Son düzenleme:
Merhaba,

Tek bir Kullanıcı Tanımlı Fonksiyon ile yapılabilecek haline getirdim.
Fonksiyonda şifrelenecek metinden başka kaç karakter ileri ya da geri gideceği değeri de parametre olarak vermek gerek.
İlk değer olarak ben 3 kabul ettim. Bu parametreyi kullanmazsanız fonksiyon otomatik olarak 3 karakter ilerisini belirleyecektir.
Tersine döndürmek için de -3 olarak kullanmanız gerekecek.
Kodlar büyük/küçük harf duyarlı hale getirildi.


Şifrelemek için :
Kod:
=sfr(A1;5)
Şifreyi Çözmek için :
Kod:
=sfr(A1;-5)

Kod:
Function sfr(ByVal met As String, Optional ByVal Duzey As Integer = 3) As String

Dim txt As String
Dim i   As Integer
Dim j   As Integer

Dim t   As String

For i = 1 To Len(met)
    t = Mid(met, i, 1)
    j = Evaluate("=CODE(""" & t & """)") + Duzey
    If j > 255 Then
        j = j - 255
    ElseIf j < 0 Then
        j = j + 255
    End If
    txt = txt & Evaluate("=CHAR(""" & j & """)")
Next i

sfr = txt

End Function
 
Son düzenleme:
Merhaba Necdet Bey,
Sizlere minnettarım, Teşekkürlerimi sunuyorum...
Mükemmel olmuş, süper çalışıyor...
Çok sağ olun var olun, iyi ki varsınız...
 
=sfr(A1;2) kodluyor ama
=sfr(A1;-2) şifreyi açmıyor #DEĞER! hatası veriyor.
küçük rakamlarla çalıştığım için bunu farkettim, diğer rakamlara bakmadım...
 
Mükemmel olmuş Necdet üstad.
Geri şifreyi çözerken bazı değerler soruna sebep oluyor: -2 gibi (negatif) değerler için, 256 ekleyince sorun çözülüyor. 2 geri gitmek yerine 254 ileri gitmek gibi.

Bu arada, bir fantezi olarak, 3 rotorlu standart enigma makinesinin yaptığı şifreleme mantığını taklit eden (ve makina ayarlarını girebileceğimiz inputboxlar ile zenginleştirilmiş) bir makro şahane olurdu.
 
Son düzenleme:
Selam HücrelereFısıldayanAdam
"- "girişlerde yani şifre çözmede sadece 2 rakamında sıkıntı var nedense... 35 e kadar bütün rakamları denedim (malum 35 den sonra harf ve karakter sayısını aşıyor. Dediğiniz gibi bende farklı işlemlerle zenginleştirmeye çalışıyorum. Mesela;
Şifrelenmiş metnin başına 5 ve sonuna da 2 ekledim. (Tabi bu rakamlar değişken oluyor.)
Şifre çözme işleminde ise bu sayıları kullanarak kaydırma işlemi yapılacak olan sayıyı buluyort. Bu 5-2=3 olarak işlem yapıyor.
Dolayısıyla şifre gelince anahtar rakamı sormak gerekmiyor, çünkü o da şifreye dahil edilmiş oluyor....
Herkese kolay gelsin...
 
Son düzenleme:
Geri
Üst