• DİKKAT

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

macroda şifre olsturmak.

  • Konbuyu başlatan Konbuyu başlatan can-can
  • Başlangıç tarihi Başlangıç tarihi
C

can-can

Katılım
26 Mart 2017
Mesajlar
31
Excel Vers. ve Dili
excel 2013
merhaba macro kullanarak nasıl sifre olusturabilirim?
ne kadar aradımsa ugrastımsa da bir sonuca ulasamadım.
excelde yeniyim siz degerli forum sakinlerinden istegim su; sessiz harflerden sonra sesli ,sesli harfleden sonra sessiz. misal: sadabaca... bu sekilde bir macro olusturabilirseniz size cok minnettar kalacagım.
 
can-can' Alıntı:
merhaba macro kullanarak nasıl sifre olusturabilirim?
ne kadar aradımsa ugrastımsa da bir sonuca ulasamadım.
excelde yeniyim siz degerli forum sakinlerinden istegim su; sessiz harflerden sonra sesli ,sesli harfleden sonra sessiz. misal: sadabaca... bu sekilde bir macro olusturabilirseniz size cok minnettar kalacagım.
Genişletmek için tıkla ...
Ekli dosyayı ineceleyiniz. Alfa-Numerik şifre üretiyor. Sayfada CTRL+P yaparsanız a sütunun da üretilen şiferleri göreceksiniz.
Alıntıdır
Kod: 
http://s3.dosya.tc/server11/udzuap/Sifre_Uretici.rar.html
 

Ekli dosyalar

Son düzenleme:
hexadesimal' Alıntı:
Ekli dosyayı ineceleyiniz. Alfa-Numerik şifre üretiyor. Sayfada CTRL+P yaparsanız a sütunun da üretilen şiferleri göreceksiniz.
Alıntıdır
Kod: 
http://s3.dosya.tc/server11/udzuap/Sifre_Uretici.rar.html
Genişletmek için tıkla ...
öncelikle cevabınız için cok cok tesekkur ederim. makro sorunsuz calısıyor fakat,harflerin ve sayıların rast gele değil de belli bir metod ile gelmesi mümkünmüdür? sessiz harften sonra sesli gelmesi gibi. eğer mümkünse bir yardımcı olsanız size cok minnettaer kalacagım.tekrardan cok tesekkurler...
 
can-can' Alıntı:
öncelikle cevabınız için cok cok tesekkur ederim. makro sorunsuz calısıyor fakat,harflerin ve sayıların rast gele değil de belli bir metod ile gelmesi mümkünmüdür? sessiz harften sonra sesli gelmesi gibi. eğer mümkünse bir yardımcı olsanız size cok minnettaer kalacagım.tekrardan cok tesekkurler...
Genişletmek için tıkla ...

Şifrede karışıklığa sebep olmaması için aşağıdaki şekilde bir karakter seti kullanmakta fayda var. Bu karakter setinde "r,l,1,j,o,0,O" gibi karakterler dahil değil.

Kod: 
liste="wetyupasdfghkzxcvbnmWERTYUPASDFGHKZXCVBNM2345679*?=/\+%"
 
Öcelikle sizin düşündüğünüz şifre formatı nedir?
Aşağıdaki şekilde bir iki örnek şifre yazabilir misiniz?

Kural:
* İlk harf Sessiz büyük
* Sonraki harf sesli küçük,
* Sonraki iki karakter sayı
* Sonraki harf sessiz küçük
* Sonraki harf sessiz küçük
* Sonraki karakter özel karakter
* Sonraki karakter sayı

Me33se*1
Na42da/3
 
asri' Alıntı:
Öcelikle sizin düşündüğünüz şifre formatı nedir?
Aşağıdaki şekilde bir iki örnek şifre yazabilir misiniz?

Kural:
* İlk harf Sessiz büyük
* Sonraki harf sesli küçük,
* Sonraki iki karakter sayı
* Sonraki harf sessiz küçük
* Sonraki harf sessiz küçük
* Sonraki karakter özel karakter
* Sonraki karakter sayı

Me33se*1
Na42da/3
Genişletmek için tıkla ...

cevabiniz için çok teşekkürler. harflerin büyük veya küçükoolması önemli değil.sadece sessiz harften sonra sesli gelecek sekilde olsun yeter. ornek olarak decabucobakinavi...bunun gibi olsun . cok tesekkur ederim ilginiz icin cevablarinizi bekliyorum. saygilar..
 
kaç adet ve her bir şifrenin kaç karakter olacağını belirleyin.
A kolonuna benzersiz olarak listeyecektir.

Kısır döngüye girmemesi için az karakter sayısı girip çok adet belirlemeyiniz.

Kod: 
Sub sifre_sessiz_sesli()
 Range("A:A").ClearContents
 
 adet = 10000
 kackarakter = 15
 
 sesliharfler = "aeiou"
 seslisay = Len(sesliharfler)
 sessizharfler = "bcdfghjklmnpqrstvwxyz"
 sessizsay = Len(sessizharfler)

 say = 0
 For i = 1 To adet
   kelime = ""
   For j = 1 To kackarakter
     Randomize
     seslisec = Int(Rnd() * seslisay) + 1
     sessizsec = Int(Rnd() * sessizsay) + 1
     If j Mod 2 = 0 Then
        kelime = kelime & Mid(sesliharfler, seslisec, 1)
     Else
        kelime = kelime & Mid(sessizharfler, sessizsec, 1)
     End If
   Next j
   sonsatir = Cells(Rows.Count, "A").End(3).Row
   If WorksheetFunction.CountIf(Range("A1:A" & sonsatir), kelime) <= 0 Then
      say = say + 1
      Cells(say, 1).Value = kelime
      If say = adet Then Exit Sub

   Else
     i = i - 1
   End If
 Next i
End Sub
 
Sayın asri;
Bu uygulamayı aynı anda B sutununa da uygulamak istesek yardımlarınız.
 
mars2' Alıntı:
Sayın asri;
Bu uygulamayı aynı anda B sutununa da uygulamak istesek yardımlarınız.
Genişletmek için tıkla ...

Soruyu tam anlamadım,
A daki değer B de demi olacak?
A da farklı B de farklı mı olacak?
Toplam şifre sayısına A ve B dahil mi olacak?
A ve B de şifre sayıları ayrı ayrı toplam şifre sayısı kadar mı olacak?
 
asri' Alıntı:
kaç adet ve her bir şifrenin kaç karakter olacağını belirleyin.
A kolonuna benzersiz olarak listeyecektir.

Kısır döngüye girmemesi için az karakter sayısı girip çok adet belirlemeyiniz.

Kod: 
Sub sifre_sessiz_sesli()
 Range("A:A").ClearContents
 
 adet = 10000
 kackarakter = 15
 
 sesliharfler = "aeiou"
 seslisay = Len(sesliharfler)
 sessizharfler = "bcdfghjklmnpqrstvwxyz"
 sessizsay = Len(sessizharfler)

 say = 0
 For i = 1 To adet
   kelime = ""
   For j = 1 To kackarakter
     Randomize
     seslisec = Int(Rnd() * seslisay) + 1
     sessizsec = Int(Rnd() * sessizsay) + 1
     If j Mod 2 = 0 Then
        kelime = kelime & Mid(sesliharfler, seslisec, 1)
     Else
        kelime = kelime & Mid(sessizharfler, sessizsec, 1)
     End If
   Next j
   sonsatir = Cells(Rows.Count, "A").End(3).Row
   If WorksheetFunction.CountIf(Range("A1:A" & sonsatir), kelime) <= 0 Then
      say = say + 1
      Cells(say, 1).Value = kelime
      If say = adet Then Exit Sub

   Else
     i = i - 1
   End If
 Next i
End Sub
Genişletmek için tıkla ...

cok tesekkurler tam istediğim gibi Allah sizden razı olsun...
 
Sayın asri;
İlginize teşekkürler, şifreleme A stununda ayrı B sutununda ayrı olacak


A B
asuedljt veliskyn gibi
 
mars2' Alıntı:
Sayın asri;
İlginize teşekkürler, şifreleme A stununda ayrı B sutununda ayrı olacak


A B
asuedljt veliskyn gibi
Genişletmek için tıkla ...

Aşağıdaki şekilde deneyiniz.

Kod: 
Sub menu()
  Application.ScreenUpdating = False
   Call sifre_sessiz_sesli_a
   Call sifre_sessiz_sesli_b
  Application.ScreenUpdating = True
End Sub

Sub sifre_sessiz_sesli_a()
 Range("A:A").ClearContents
 
 adet = 1000
 kackarakter = 15
 
 sesliharfler = "aeiou"
 seslisay = Len(sesliharfler)
 sessizharfler = "bcdfghjklmnpqrstvwxyz"
 sessizsay = Len(sessizharfler)

 say = 0
 For i = 1 To adet
   kelime = ""
   For j = 1 To kackarakter
     Randomize
     seslisec = Int(Rnd() * seslisay) + 1
     sessizsec = Int(Rnd() * sessizsay) + 1
     If j Mod 2 = 0 Then
        kelime = kelime & Mid(sesliharfler, seslisec, 1)
     Else
        kelime = kelime & Mid(sessizharfler, sessizsec, 1)
     End If
   Next j
   sonsatir = Cells(Rows.Count, "A").End(3).Row
   If WorksheetFunction.CountIf(Range("A1:A" & sonsatir), kelime) <= 0 Then
      say = say + 1
      Cells(say, 1).Value = kelime
      If say = adet Then Exit Sub
   Else
     i = i - 1
   End If
 Next i
End Sub

Sub sifre_sessiz_sesli_b()
 Range("B:B").ClearContents
 
 adet = 1000
 kackarakter = 15
 
 sesliharfler = "aeiou"
 seslisay = Len(sesliharfler)
 sessizharfler = "bcdfghjklmnpqrstvwxyz"
 sessizsay = Len(sessizharfler)

 say = 0
 For i = 1 To adet
   kelime = ""
   For j = 1 To kackarakter
     Randomize
     seslisec = Int(Rnd() * seslisay) + 1
     sessizsec = Int(Rnd() * sessizsay) + 1
     If j Mod 2 = 0 Then
        kelime = kelime & Mid(sesliharfler, seslisec, 1)
     Else
        kelime = kelime & Mid(sessizharfler, sessizsec, 1)
     End If
   Next j
   sonsatir = Cells(Rows.Count, "B").End(3).Row
   If WorksheetFunction.CountIf(Range("B1:B" & sonsatir), kelime) <= 0 Then
      say = say + 1
      Cells(say, 2).Value = kelime
      If say = adet Then Exit Sub

   Else
     i = i - 1
   End If
 Next i
End Sub
 
Teşekkürler
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst