Kombinasyon makrosunda düzeltme

Muharrem41 · 24 Temmuz 2017

Kod:

Sub Listele()
Dim X As Byte, z As Long
Dim a As Byte, b As Byte, c As Byte, d As Byte, e As Byte, f As Byte, g As Byte

X = 49

For a = 1 To X
For b = a + 1 To X
For c = b + 1 To X
For d = c + 1 To X
For e = d + 1 To X
For f = e + 1 To X
z = z + 1
Cells(z, 1) = a
Cells(z, 2) = b
Cells(z, 3) = c
Cells(z, 4) = d
Cells(z, 5) = e
Cells(z, 6) = f
Next f
Next e
Next d
Next c
Next b
Next a

End Sub

Merhaba arkadaşlar elimde şöyle bir macro var macro çalışıyor fakat sayıları tam olarak üretmiyor benim istedigim excel satırı 1048576 da hata veriyor satır bittikten sonra kalan sayıları ghıijk sutunlarına yazdıra bilirmiyim lütfen yardım

BedriA · 24 Temmuz 2017

Yazdırdığınız sayfanın adı nedir?
Ayrıca bu koddaki döngü ne zaman bitiyor?

Sonsuza mı gitmeye çalışıyor bu kod?

BedriA · 24 Temmuz 2017

C(49,6)=?
Üretmesi gereken kombinasyon sayısı.

Korhan Ayhan · 24 Temmuz 2017

Aşağıdaki gibi kullanabilirsiniz.

Kod:

Sub Listele()
    Dim x As Byte, y As Long, z As Long
    Dim a As Byte, b As Byte, c As Byte, d As Byte, e As Byte, f As Byte, g As Byte
    
    Cells.Clear
    x = 49
    z = 1
    
    For a = 1 To x
        For b = a + 1 To x
            For c = b + 1 To x
                For d = c + 1 To x
                    For e = d + 1 To x
                        For f = e + 1 To x
                            y = y + 1
                            If y > 1048576 Then
                                y = 1
                                z = z + 7
                            End If
                            Cells(y, z) = a
                            Cells(y, z + 1) = b
                            Cells(y, z + 2) = c
                            Cells(y, z + 3) = d
                            Cells(y, z + 4) = e
                            Cells(y, z + 5) = f
                        Next f
                    Next e
                Next d
            Next c
        Next b
    Next a

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

BedriA · 24 Temmuz 2017

Korhan Ayhan' Alıntı:

Aşağıdaki gibi kullanabilirsiniz.

Kod:

Sub Listele()
    Dim x As Byte, y As Long, z As Long
    Dim a As Byte, b As Byte, c As Byte, d As Byte, e As Byte, f As Byte, g As Byte
    
    Cells.Clear
    x = 49
    z = 1
    
    For a = 1 To x
        For b = a + 1 To x
            For c = b + 1 To x
                For d = c + 1 To x
                    For e = d + 1 To x
                        For f = e + 1 To x
                            y = y + 1
                            If y > 1048576 Then
                                y = 1
                                z = z + 7
                            End If
                            Cells(y, z) = a
                            Cells(y, z + 1) = b
                            Cells(y, z + 2) = c
                            Cells(y, z + 3) = d
                            Cells(y, z + 4) = e
                            Cells(y, z + 5) = f
                        Next f
                    Next e
                Next d
            Next c
        Next b
    Next a

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Korhan Hocam,

Döngünün tamamlanması ne kadar sürdü?
Ben de sürekli excel sayfası dondu, işlemin sonunu göremedim yani.

BedriA · 24 Temmuz 2017

14 sütun oluşuyor.
Sayısal Loto'yu tutturma ihtimali 1/13 983 816.

Muharrem41 · 24 Temmuz 2017

sayfa yanıt vermiyor hocam

Muharrem41 · 24 Temmuz 2017

hatamı var

PLİNT · 25 Temmuz 2017

Muharrem41' Alıntı:
hatamı var

Merhaba
Aşağıdaki gibi deneyiniz, hem hızlı olması açısından faydası olacaktır.

Kod:

[SIZE="2"]Sub Listele()
Dim kom()
Dim a, b, c, d, e, f, i, x, n, j As Integer
Cells.Clear
ReDim kom(1 To 6, 1 To 65536)
i = 0: n = 1: j = 1: x = 0
For a = 1 To [COLOR="Red"]44[/COLOR]
For b = a + 1 To [COLOR="Red"]45[/COLOR]
For c = b + 1 To [COLOR="Red"]46[/COLOR]
For d = c + 1 To [COLOR="Red"]47[/COLOR]
For e = d + 1 To [COLOR="Red"]48[/COLOR]
For f = e + 1 To 49
i = i + 1
kom(1, i) = a
kom(2, i) = b
kom(3, i) = c
kom(4, i) = d
kom(5, i) = e
kom(6, i) = f
If i = 65536 Then
x = x + 1
Cells(n, j).Resize(i, 6) = Application.Transpose(kom)
If x = Rows.Count / 65536 Then
x = 0: n = 1: i = 0
j = j + 6
End If
Cells(n + i, j).Select
n = n + i
 Erase kom: i = 0
ReDim kom(1 To 6, 1 To 65536)
 End If
Next: Next: Next: Next: Next: Next
[COLOR="Blue"]If i > 0 Then Cells(n, j).Resize(i, 6) = Application.Transpose(kom)[/COLOR]
End Sub
 [/SIZE]

Korhan Ayhan · 25 Temmuz 2017

Hata yok. Makronun bitmesini beklemeniz gerekiyor. İç içe döngü olduğu için uzun sürecektir.

Alternatif olarak verilen kodu deneyiniz. Daha hızlı sonuç üretecektir.

Muharrem41 · 26 Temmuz 2017

plint' Alıntı:

merhaba
aşağıdaki gibi deneyiniz, hem hızlı olması açısından faydası olacaktır.

Kod:

[sıze="2"]sub listele()
dim kom()
dim a, b, c, d, e, f, i, x, n, j as ınteger
cells.clear
redim kom(1 to 6, 1 to 65536)
i = 0: N = 1: J = 1: X = 0
for a = 1 to [color="red"]44[/color]
for b = a + 1 to [color="red"]45[/color]
for c = b + 1 to [color="red"]46[/color]
for d = c + 1 to [color="red"]47[/color]
for e = d + 1 to [color="red"]48[/color]
for f = e + 1 to 49
i = i + 1
kom(1, i) = a
kom(2, i) = b
kom(3, i) = c
kom(4, i) = d
kom(5, i) = e
kom(6, i) = f
ıf i = 65536 then
x = x + 1
cells(n, j).resize(i, 6) = application.transpose(kom)
ıf x = rows.count / 65536 then
x = 0: N = 1: I = 0
j = j + 6
end ıf
cells(n + i, j).select
n = n + i
 erase kom: I = 0
redim kom(1 to 6, 1 to 65536)
 end ıf
next: Next: Next: Next: Next: Next
[color="blue"]ıf i > 0 then cells(n, j).resize(i, 6) = application.transpose(kom)[/color]
end sub
 [/sıze]

hocam eline koluna emeğine sağlık teşekkür ederim

Muharrem41 · 9 Ağustos 2017

korhan hocam bu makroyu 10 lu sütün a nasıl dönüştürebilirim

Muharrem41 · 9 Ağustos 2017

hocam bun 10 lu sütün a nasıl cevirebilirim

Korhan Ayhan · 9 Ağustos 2017

10'lu sütundan kastınız nedir?

Muharrem41 · 9 Ağustos 2017

123456 lı olarak değilde
konbinasyon u
12345678910 olarak yapmak istiyorum 30/10

Muharrem41 · 10 Ağustos 2017

Hocam iyi akşamlar

Kod:

Sub Listele()
    Dim x As Byte, y As Long, z As Long
    Dim a As Byte, b As Byte, c As Byte, d As Byte, e As Byte, f As Byte, g As Byte
    
    Cells.Clear
    x = 49
    z = 1
    
    For a = 1 To x
        For b = a + 1 To x
            For c = b + 1 To x
                For d = c + 1 To x
                    For e = d + 1 To x
                        For f = e + 1 To x
                            y = y + 1
                            If y > 1048576 Then
                                y = 1
                                z = z + 7
                            End If
                            Cells(y, z) = a
                            Cells(y, z + 1) = b
                            Cells(y, z + 2) = c
                            Cells(y, z + 3) = d
                            Cells(y, z + 4) = e
                            Cells(y, z + 5) = f
                        Next f
                    Next e
                Next d
            Next c
        Next b
    Next a

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

KORHAN HOCAM BUNU SİZ YAPTINIZ BEN BUNU 6 LI SÜTÜNDA DEĞİLDE 10 LU SÜTUNDA YAPMAK İSTİYORUM

Korhan Ayhan · 10 Ağustos 2017

1-49 arası sayıların 10'lu kombinasyonlarını istiyorsunuz? Doğru mudur?

Muharrem41 · 10 Ağustos 2017

1/30

Evet hocam ben 1/30 olarak düşünüyorum

Muharrem41 · 10 Ağustos 2017

Korhan hocam böyle bir şansım varmı matık en olması lazım diye düşünüyorum

Muharrem41 · 11 Ağustos 2017

macro hakkında

PLİNT' Alıntı:

Merhaba
Aşağıdaki gibi deneyiniz, hem hızlı olması açısından faydası olacaktır.

Kod:

[SIZE="2"]Sub Listele()
Dim kom()
Dim a, b, c, d, e, f, i, x, n, j As Integer
Cells.Clear
ReDim kom(1 To 6, 1 To 65536)
i = 0: n = 1: j = 1: x = 0
For a = 1 To [COLOR="Red"]44[/COLOR]
For b = a + 1 To [COLOR="Red"]45[/COLOR]
For c = b + 1 To [COLOR="Red"]46[/COLOR]
For d = c + 1 To [COLOR="Red"]47[/COLOR]
For e = d + 1 To [COLOR="Red"]48[/COLOR]
For f = e + 1 To 49
i = i + 1
kom(1, i) = a
kom(2, i) = b
kom(3, i) = c
kom(4, i) = d
kom(5, i) = e
kom(6, i) = f
If i = 65536 Then
x = x + 1
Cells(n, j).Resize(i, 6) = Application.Transpose(kom)
If x = Rows.Count / 65536 Then
x = 0: n = 1: i = 0
j = j + 6
End If
Cells(n + i, j).Select
n = n + i
 Erase kom: i = 0
ReDim kom(1 To 6, 1 To 65536)
 End If
Next: Next: Next: Next: Next: Next
[COLOR="Blue"]If i > 0 Then Cells(n, j).Resize(i, 6) = Application.Transpose(kom)[/COLOR]
End Sub
 [/SIZE]

hocam bunu 123456 lı olarak değilde
kombinasyon u
12345678910 olarak yapmak istiyorum yani 1/30 kombinasyon unu 10 lu istiyorum mümkünmü?

Kombinasyon makrosunda düzeltme

Muharrem41

BedriA

BedriA

Korhan Ayhan

Administrator

BedriA

BedriA

Muharrem41

Muharrem41

PLİNT

Korhan Ayhan

Administrator

Muharrem41

Muharrem41

Muharrem41

Korhan Ayhan

Administrator

Muharrem41

Muharrem41

Korhan Ayhan

Administrator

Muharrem41

Muharrem41

Muharrem41