kombinasyon listesi yapma

[Blacklion27]

Arkadaşlar böyle bir kombinasyon listesi nasıl yapabiliriz her birinden rastgele 1 0 veya 2 sayısı alınarak her şekilde alt alt getirmesini istiyorum 4 milyon küsür olasılık çıkmalı

 

[Asri]

C,D,E,F deki değerleri hangi kritere göre oluşturduğunuzu yazarsanız daha hızlı sonuç alırsınız?

* Neden kombinasyonda sıfır yok
* x karakteri kombinasyona hangi kritere göre dahil oluyor.

 

[Blacklion27]

kombinasyondaki X 0 oraya yazmamışım ve kombinasyonda herhangi bir kriter yok hepsi rastgele her sonuç alınacak sekilde alt alta 15 sıralanmalı 4 milyon küsür kombine çıkmalı ben herhangi bir yoldan yaptım 1 milyon küsür kombine çıktı benim yöntemle 4 milyon çıkmalı ama satır sayısı 1 milyon küsür ve bende pek excel bilmediğim için benim yöntemle 1 milyon küsür kombine yapabiliyorum ancak bir arkadaş makroyla yapabilirsin demişti bir bilginiz var mı?

 

[Asri]

kombinasyondaki X 0 oraya yazmamışım ve kombinasyonda herhangi bir kriter yok hepsi rastgele her sonuç alınacak sekilde alt alta 15 sıralanmalı 4 milyon küsür kombine çıkmalı ben herhangi bir yoldan yaptım 1 milyon küsür kombine çıktı benim yöntemle 4 milyon çıkmalı ama satır sayısı 1 milyon küsür ve bende pek excel bilmediğim için benim yöntemle 1 milyon küsür kombine yapabiliyorum ancak bir arkadaş makroyla yapabilirsin demişti bir bilginiz var mı?

102 yani 1,0,2 nin 4 lü kombinasyonunu mu istiyorsunuz?
rakamlar değişebilir. 3 rakam sabit mi?

 

[Blacklion27]

102 nin 15 li kombinasyonunu istiyorum rakamlar sabit değil her rakam değişerek alt alta 15 li olarak sıralanacak fotodaki gibi 4 milyon küsür kombinasyon var yapılabilir mi

 

[Asri]

102 nin 15 li kombinasyonunu istiyorum rakamlar sabit değil her rakam değişerek alt alta 15 li olarak sıralanacak fotodaki gibi 4 milyon küsür kombinasyon var yapılabilir mi

Aradığınız sonuç şöyle bir sonuç ise numarator olarak yazdığım bir konu bu şekilde düzeneyebilirim


0-0-0-0-0-0-0-0-0-0-0-0-0-0-0
0-0-0-0-0-0-0-0-0-0-0-0-0-0-1
0-0-0-0-0-0-0-0-0-0-0-0-0-0-2
0-0-0-0-0-0-0-0-0-0-0-0-0-1-0
0-0-0-0-0-0-0-0-0-0-0-0-0-1-1
0-0-0-0-0-0-0-0-0-0-0-0-0-1-2
0-0-0-0-0-0-0-0-0-0-0-0-0-2-0
0-0-0-0-0-0-0-0-0-0-0-0-0-2-1
0-0-0-0-0-0-0-0-0-0-0-0-0-2-2
0-0-0-0-0-0-0-0-0-0-0-0-1-0-0
0-0-0-0-0-0-0-0-0-0-0-0-1-0-1
0-0-0-0-0-0-0-0-0-0-0-0-1-0-2

 

[Blacklion27]

evet kardeşim tam da bunun gibi ne dersin yapılabilir mi çok kombin çıkıyor ama

 

[Asri]

evet kardeşim tam da bunun gibi ne dersin yapılabilir mi çok kombin çıkıyor ama

Yapılabilir, çok çıkması da sizin sorununuz.
Mecbur beklenecek

 

[Blacklion27]

siz mi yapacaksınız

 

[Asri]

siz mi yapacaksınız

arkadaşlar da farklı çözümler sunabilir. Bende uygun zamanda bir çözüm sunarım

 

[Blacklion27]

tamam kardeşim teşekkürler bekliyorum bende uğraşayım o arada

 

[Blacklion27]

sen yukarıda bana attığın örnekte belli bir kurala örüntü olarakmı göre mi yaptın yoksa rastgele mi ben rastgele istiyorum ondan sordum

 

[excel41]

222012122121110
201212210210101
122120121212222

eğer böyle birşey istiyorsanız bir şarta bağlı değil ise

=YUVARLA(S_SAYI_ÜRET()*2;0)

 

[Asri]

sen yukarıda bana attığın örnekte belli bir kurala örüntü olarakmı göre mi yaptın yoksa rastgele mi ben rastgele istiyorum ondan sordum

Bu önerim her ihtimali hesaplayarak oluşturuyor.
Rastgele değil. Rastgele ürettiğinde her üretilen sonucun önceden üretilmemiş olduğunu kontrol etmek gerekecek.

 

[Blacklion27]

Bu önerim her ihtimali hesaplayarak oluşturuyor.

Evet bende her ihtimali hesaplamasını istiyorum. Rastgele değil 3 ihtimalinde 15 olarak her şekilde kombinlemesi

 

[Asri]

Ekli dosya bulunduğu yere sonuc.txt olarak kombinasyonu oluşturur.
15 karakteri bir defada denemeyin. Çok zaman alacaktır.

http://s7.dosya.tc/server13/t2nato/KombiNumarator.zip.html

Dim veri() As String
Dim adet As Long
Dim elde, bakilansayi As Boolean
Dim sayilar As String

Const harfler As String = "ABCDEFGĞHIİJKLMNOÖPRSŞTUÜXWVYZ"
'Const sayilar As String = "01"
Const dahildegil As String = ".-/"
'Asri Akdeniz - www.asriakdeniz.com - asriakdeniz@gmail.com

Sub listeyeyukle()
    Dim veri As String
    Application.ScreenUpdating = False
    yol = ActiveWorkbook.Path & "\sonuc.txt"
    
    If Not FileExists(yol) Then
      MsgBox ("Sonuc.txt dosyası mevcut değil.")
      Exit Sub
    End If
    
    Sheets("Liste").Cells.Clear
    sonsatir = Cells(9, "A").Value
    satir = 0
    sutun = 1
    Open yol For Input As #1
    Do Until EOF(1)
        Line Input #1, veri
        If satir > sonsatir Then
           satir = 0
           sutun = sutun + 1
        End If
        satir = satir + 1
        Sheets("Liste").Cells(satir, sutun) = "'" & veri
    Loop
    Close #1
    Sheets("Liste").Select
    Cells.EntireColumn.AutoFit
    Range("A2").Select
    
    Application.ScreenUpdating = True
End Sub

   
Sub kombiolustur()
   Range("B:B").Clear
   numarastr = Cells(2, "A").Value
   numarastrorj = numarastr
   sayilar = Cells(4, "A").Value
   yol = ActiveWorkbook.Path & "\sonuc.txt"
   If FileExists(yol) Then Kill (yol)
   Open yol For Output As #1
   
   Z = 0
   Do
     numarastr = numarator(numarastr)
     If Len(numarastr) > Len(numarastrorj) Then GoTo son
     Print #1, numarastr
     'Z = Z + 1
     'Cells(Z, 2).Value = "'" & numarastr
     
   Loop Until 2 < 1
son:
   Close #1
   MsgBox ("İşlem tamamlandı")
End Sub

Function numarator(numara) As String
   numara = StrReverse(numara)
   adet = Len(numara)
   ReDim Preserve veri(1 To adet)
   For i = 1 To adet
      veri(i) = Mid(numara, i, 1)
   Next i
   
   elde = False
   For j = LBound(veri) To UBound(veri)
      harf = veri(j)
      If InStr(dahildegil, harf) > 0 Then GoTo son
      bakilansayi = sayimi(harf)
      If bakilansayi Then
         veri(j) = sayiarttir(harf)
      Else
         veri(j) = harfarttir(harf)
      End If
      
      If elde = False Then
        Exit For
      End If
son:
   Next j
        
   For i = LBound(veri) To UBound(veri)
      veristr = veristr & veri(i)
   Next i
   
   veristr = StrReverse(veristr)
   If Left(veristr, 1) = Left(sayilar, 1) And elde Then
      numarator = "1" & veristr
   ElseIf Left(veristr, 1) = Left(harfler, 1) And elde Then
      numarator = Left(harfler, 1) & veristr
   Else
      numarator = veristr
   End If
End Function

Function harfarttir(harfstr) As String
    mevcutsira = InStr(harfler, harfstr)
    yenisira = Mid(harfler, mevcutsira + 1, 1)
    If yenisira = "" Then
       harfarttir = Mid(harfler, 1, 1)
       elde = True
    Else
       harfarttir = yenisira
       elde = False
    End If
End Function

Function sayiarttir(sayistr) As String
    mevcutsira = InStr(sayilar, sayistr)
    yenisira = Mid(sayilar, mevcutsira + 1, 1)
    If yenisira = "" Then
       sayiarttir = Mid(sayilar, 1, 1)
       elde = True
    Else
       sayiarttir = yenisira
       elde = False
    End If
End Function


Function sayimi(sadecesayistr)
  liste = "0123456789"
  For k = 1 To Len(sadecesayistr)
    harf = Mid(sadecesayistr, k, 1)
    If InStr(liste, harf) = 0 Then
       sayimi = False
       Exit Function
    End If
  Next k
  sayimi = True
End Function

Public Function FileExists(ByVal filePath As String) As Boolean
FileExists = CBool(LenB(Dir(filePath, vbHidden + vbNormal + vbSystem + vbReadOnly + vbArchive)))
End Function

 

[Blacklion27]

Altın üyeliğim yok

 

[Asri]

Altın üyeliğim yok

Kodları vba da modul1 e yapıştırın.
A2 ye 0-0-0-0 yazın
A4 e '012 yazın

Bir butona kombiolustur u atayın.

 

[Asri]

Yukarıdaki işlem olmaz ise 16. mesaja harici dosya linki eklendi.

 

[Blacklion27]

vba yla ilgili bilgim yoktu bende bilgi edinmeye çalışıyordum eklediğiniz dosyayı indirdim denedim sonuç oluştur a tıkladım işlem tamamlandı dediği halde başlangıç numarası değişmedi