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..
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,359
Excel Vers. ve Dili
Ofis 365 Türkçe
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

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
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.
 
Katılım
8 Haziran 2007
Mesajlar
21
Excel Vers. ve Dili
2007 tur
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.
 
Katılım
8 Haziran 2007
Mesajlar
21
Excel Vers. ve Dili
2007 tur
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ı
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,359
Excel Vers. ve Dili
Ofis 365 Türkçe
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.
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
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
 

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Pardon, sorun farklı şekilde çözülmüş, benim yaptığım gibi olur mu?
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,359
Excel Vers. ve Dili
Ofis 365 Türkçe
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ı.
 
Katılım
8 Haziran 2007
Mesajlar
21
Excel Vers. ve Dili
2007 tur
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:

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,359
Excel Vers. ve Dili
Ofis 365 Türkçe
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

Katılım
8 Haziran 2007
Mesajlar
21
Excel Vers. ve Dili
2007 tur
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.
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,359
Excel Vers. ve Dili
Ofis 365 Türkçe
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.
 
Katılım
2 Nisan 2008
Mesajlar
130
Excel Vers. ve Dili
2003 TÜRKÇE
Altın Üyelik Bitiş Tarihi
25.05.2019
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..
 
Katılım
2 Nisan 2008
Mesajlar
130
Excel Vers. ve Dili
2003 TÜRKÇE
Altın Üyelik Bitiş Tarihi
25.05.2019
Selam Necdet Bey,
Sizden yardım bekliyorum,
Teşekkürler...
 
Son düzenleme:

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,359
Excel Vers. ve Dili
Ofis 365 Türkçe
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:
Katılım
2 Nisan 2008
Mesajlar
130
Excel Vers. ve Dili
2003 TÜRKÇE
Altın Üyelik Bitiş Tarihi
25.05.2019
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...
 
Katılım
2 Nisan 2008
Mesajlar
130
Excel Vers. ve Dili
2003 TÜRKÇE
Altın Üyelik Bitiş Tarihi
25.05.2019
=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...
 
Katılım
9 Şubat 2022
Mesajlar
204
Excel Vers. ve Dili
Office 2021 Türkçe (x64)
Altın Üyelik Bitiş Tarihi
09-02-2027
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:
Katılım
2 Nisan 2008
Mesajlar
130
Excel Vers. ve Dili
2003 TÜRKÇE
Altın Üyelik Bitiş Tarihi
25.05.2019
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:
Üst