Bir grubun içinden seçilen 4 farklı karakter grubun her satırında kaçar adettir?

[Tevfik_Kursun]

Merhaba Arkadaşlar,
Ekli dosyada;
her satırında 10 farklı karakterden oluşan 40 karakter var (mavi bölge)
her satırındaki 10 farklı karakter grubu (sarı bölge) (23 farklı karakter var)
sarı bölgeden 4 farklı karakter seçeceğiz. C(23,4) = 8855 adet 4 lü grup oluşuyor.
Her seçilen 4 lü (kırmızı karakterler) için mavi bölgenin aynı satırında kaçar tane var.
Bu çalışmayı rastgeleara fonksiyonu ile yaptığımda her an değişime uğruyor, o nedenle makroya geçmeye karar verdim.
İlgilenenlere şimdiden teşekkür ederim.
Saygılarımla

https://drive.google.com/open?id=0B4K-3W_BCuDpTjhFWlhXbG9tdHc

 

[alicimri]

Bir çalışma yaptım, umarım işine yarar. a>z ye 26 İngilizce karakteri kullanıyor. boş bir sayfada deneyin.

Sub a()
   Columns("A:BF").ClearContents
    Columns("A:BF").ColumnWidth = 1
For i = 1 To 4
e = 1
Do While Cells(Rows.Count, i).End(3).Row < 10
Randomize
dd = Chr(Int((122 - 97 + 1) * Rnd + 97))
If WorksheetFunction.CountIf(Range(Cells(1, i), Cells(10, i)), dd) = 0 Then
Cells(e, i).Value = dd
e = e + 1
End If
Loop
Next
For x = 6 To 9
q = 1
Do While Cells(Rows.Count, x).End(3).Row < 40
Randomize
dd = Chr(Int((122 - 97 + 1) * Rnd + 97))

If WorksheetFunction.CountIf(Range(Cells(1, x - 5), Cells(10, x - 5)), dd) = 1 Then
Cells(q, x).Value = dd
q = q + 1
End If
Loop
Next
Z = 1
Do While Range("K" & Rows.Count).End(3).Row < 4
Randomize
dd = Chr(Int((122 - 97 + 1) * Rnd + 97))

If WorksheetFunction.CountIf(Range("A1:D10"), dd) >= 1 And WorksheetFunction.CountIf(Range("K1:K4"), dd) = 0 Then
Range("K" & Z).Value = dd
Z = Z + 1
End If
Loop
For p = 12 To 15
For w = 1 To 4
Cells(w, p).Value = WorksheetFunction.CountIf(Range(Cells(w, p - 6), Cells(40, p - 6)), Range("K" & w))
Next
Next
   Range("F1:I40").Copy
    Range("A42").PasteSpecial Transpose:=True
     Range("A1:D100").Copy
    Range("AQ42").PasteSpecial Transpose:=True
     Range("K1:O4").Copy
      Range("BC41").PasteSpecial Transpose:=True
   Rows("1:40").Delete Shift:=xlUp
End Sub

 

[Tevfik_Kursun]

Sayın Ali Cimri Hocam,
İlginize çok teşekkür ederim. Tabii ki deneyeceğim.
Saygılarımla