• DİKKAT

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

permütasyon

iskelet

iskelet

Katılım
5 Şubat 2008
Mesajlar
231
Excel Vers. ve Dili
2003
selamlar,

1 den 8 e kadar olan sayıların 6 lı bütün permutasyonları yazdırmak istiyorum.
111111
111112
111113
111114
.......
......
......... şeklinde acaba makro ile nasıl yazdırılabilir.
Şimden ilgilenen arkadaşlara teşekkürler.
 
Selamlar,
Acaba yapılamayacak bişey mi istedim.
Yapılamayacak birşey ise de belirtirseniz sevinirim.
 
Nereye yazdıracaksınız? Bir text dosyası olabilir mi?
 
Deneyin...

Kod: 
Sub test()
Dim arr() As Long
Dim sutun As Byte
Dim x As Long, y As Long, s As Long

Const L = 111110
Const U = 888888

sutun = (U \ 65536)

ReDim arr(1 To 65536, 1 To sutun)

    For x = 1 To sutun
    
        For y = 1 To 65536
        
            arr(y, x) = L + s
            
            If arr(y, x) = U Then
               GoTo bitir
            End If
            
            s = s + 1
            
        Next y
        
    Next x

bitir:
Range("a1:" & Chr$(64 + sutun) & 65536) = arr

Erase arr
End Sub
 
sayın zeki bey,
ilk önce sorumla ilgilendiğiniz için teşekkür ederim.
tam olarak yapmak istediğim o değildi yapmak istediğim şey ekteki dosyada belirtilmiştir.
Yardımlarınız için tekrar teşekkürler.
 

Ekli dosyalar

Sorularınızın daha iyi anlaşılması için örnek dosya ile destekleyin.

Kod: 
Sub test2()
Dim a As Byte, b As Byte, c As Byte
Dim d As Byte, e As Byte, f As Byte
Dim s As Long

s = 4

    For a = 1 To [a1]
        For b = 1 To [b1]
            For c = 1 To [c1]
                For d = 1 To [d1]
                    For e = 1 To [e1]
                        For f = 1 To [f1]
                            Cells(s, "a") = a
                            Cells(s, "b") = b
                            Cells(s, "c") = c
                            Cells(s, "d") = d
                            Cells(s, "e") = e
                            Cells(s, "f") = f
                            s = s + 1
                        Next
                    Next
                Next
            Next
        Next
    Next
    
End Sub
 
sayın zeki bey;
Ellerinize sağlık tam istediğim gibi olmuş.
Yalnız 7 7 7 7 7 7 yazdığım zaman hata verdi acaba satır sayısı yetmediğinden dolayı mı?
Eğer satır sayısı yetmediğinden dolayı ise o sorunu nasıl düzeltebiliriz.
 
selamlar;
arkadaşlar ekli dosyadaki
A1 hücresine 7
B1 hücresine 7
c1 hücresine 7
D1 hücresine 7
E1 hücresine 7
F1 hücresine 7 yazıp makroyu çalıştırdığımda hata veriyo satır sayısı yetmediğinden mi hata veriyo acaba.
 

Ekli dosyalar

Merhaba,

Satırlar yeterli gelmiyor; yan sütunlara bölünecek şekilde çözüm üretmek gerek.
 
65536 satırı geçtigi için hata veriyor kolay gelsin...
 
peki bunu düzeltmemiz mümkün müdür? Yan satırlara geçsede olur o olmazsa diğer sayfaya geçsede olur? Yapılabilir mi benim için önemli.
 
Merhaba
Zeki Bey'in Kodlarına ilave yaptım.
Kod: 
Sub test2()
[A4:IV65536] = Empty
Dim a As Byte, b As Byte, c As Byte
Dim d As Byte, e As Byte, f As Byte
Dim s As Long
Dim x As Long
x = 1
s = 4
    For a = 1 To [a1]
        For b = 1 To [b1]
            For c = 1 To [c1]
                For d = 1 To [d1]
                    For e = 1 To [e1]
                        For f = 1 To [f1]
                            Cells(s, x) = a
                            Cells(s, x + 1) = b
                            Cells(s, x + 2) = c
                            Cells(s, x + 3) = d
                            Cells(s, x + 4) = e
                            Cells(s, x + 5) = f
                            s = s + 1
                            If s = 65536 Then x = x + 7: s = 4
                        Next
                    Next
                Next
            Next
        Next
    Next
    
End Sub
 
sayın zeki bey ve meslan bey ikinizede çok teşekkür ederim ellerinize sağlık.
Bir şu yapılabilir mi yapılamazsa o kadar önemli değil ben makroyu çalıştırdıımda bi önceki listeyi silmesi mümkün mü?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst