• DİKKAT

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

Kombinasyon, sağa doğru sütuna artan

irfancantr

Altın Üye
Katılım
18 Haziran 2007
Mesajlar
625
Excel Vers. ve Dili
Excel 365 - İmngilizce
Merhaba,

Forumda ki kombinasyon örneklerine baktım fakat kodları uyarlamakta başarı sağlayamadım.

Ben 0 - 255 arası 3'lü kombinasyon hazırlamak istiyorum,
yalnız sayı 255'e kadar geldiğinde kombinasyon sağ sütuna geçerek devam edecek şekilde nasıl hazırlayabilirim?


sütunlar yetmiyorsa eğer kaldığı yerden ikinci veya üçüncü bir sayfa oluşturarak devam edebilir mi acaba?
 

Ekli dosyalar

Tablonun son halinin nasıl olmasını istiyorsunuz?
 
Merhaba,
Yardımcı olabilecek kimse var mı?
 
Merhana
İnceleyin.Küçük sayılarla deneme yapabilirsiniz?

Excel 2007'de:
16k (2^14) =16.384 sütun
1M (2^20) = 1.048.576 satır
sütun sayısı fazla olacaksa koda bir döngü daha eklemek lazım olacak.

Kod:
Sub kombinasyon()
mynum = Application.InputBox("Enter a number"): sut = 1
For i = 0 To mynum
   For ii = 0 To mynum
              Range(Cells(1, sut), Cells(1, sut + 2)).Select
              With Selection
                 .HorizontalAlignment = xlCenter
                 .MergeCells = True
                 .FormulaR1C1 = (sut Mod 3) + Int(sut / 3)
              End With
              
       For iii = 0 To mynum
          Cells(iii + 2, sut) = i: Cells(iii + 2, sut + 1) = ii: Cells(iii + 2, sut + 2) = iii
       Next iii
       sut = sut + 3
   Next ii
Next i
End Sub
 
Merhana
İnceleyin.Küçük sayılarla deneme yapabilirsiniz?


sütun sayısı fazla olacaksa koda bir döngü daha eklemek lazım olacak.

Kod:
Sub kombinasyon()
mynum = Application.InputBox("Enter a number"): sut = 1
For i = 0 To mynum
   For ii = 0 To mynum
              Range(Cells(1, sut), Cells(1, sut + 2)).Select
              With Selection
                 .HorizontalAlignment = xlCenter
                 .MergeCells = True
                 .FormulaR1C1 = (sut Mod 3) + Int(sut / 3)
              End With
              
       For iii = 0 To mynum
          Cells(iii + 2, sut) = i: Cells(iii + 2, sut + 1) = ii: Cells(iii + 2, sut + 2) = iii
       Next iii
       sut = sut + 3
   Next ii
Next i
End Sub

Merhaba,
Elinize sağlık kod çok güzel olmuş,
peki sütun sayısı yetmediğinde ikinci bir döngü eklemek gerekli demişsiniz!
Ekleyebilir miyiz acaba?
 
Tekrar merhaba
0-255 arası 3 döngü (256*256*256) exceli kasar diye düşünüyorum.
Bence bunu ado-sql ile kalıb oluşturup çözmek daha kolay olur diye düşünüyorum.Kanatimce; eklediğim tablodaki 3.sütun (C2:C257) sabit olarak dönüyor.Biz eğer bunu A2:A257 ve B2:B257 sütunlarında döngü oluşturup döngü sayısını a1:c1 e yazdırarak çözmeyi sağlıyabilirsek işlem daha kısa olur.

Sonuçta bu beni aşıyor.
Daha deneyimli arkadaşların bu konudaki görüşlerini bekliyelim derim.
 

Ekli dosyalar

Tekrar merhaba
0-255 arası 3 döngü (256*256*256) exceli kasar diye düşünüyorum.
Bence bunu ado-sql ile kalıb oluşturup çözmek daha kolay olur diye düşünüyorum.Kanatimce; eklediğim tablodaki 3.sütun (C2:C257) sabit olarak dönüyor.Biz eğer bunu A2:A257 ve B2:B257 sütunlarında döngü oluşturup döngü sayısını a1:c1 e yazdırarak çözmeyi sağlıyabilirsek işlem daha kısa olur.

Sonuçta bu beni aşıyor.
Daha deneyimli arkadaşların bu konudaki görüşlerini bekliyelim derim.

İlginiz için teşekkürler Sayın mersilen,
Diğer görüşlere, bilgilere her zaman açığım elbette.
Dediğiniz gibi konu hakkında önerileri beklemekte fayda var.

Hayırlı akşamlar.
 
Merhaba,

Sayın Haluk hocamın kodlarından alıntı yaparak kodlara şöyle bir ekleme yaptım;
Kod:
Sub kombinasyon()
mynum = Application.InputBox("Enter a number"): sut = 1
Application.ScreenUpdating = False

For i = 0 To mynum
   For ii = 0 To mynum
              Range(Cells(1, sut), Cells(1, sut + 2)).Select
              With Selection
                 .HorizontalAlignment = xlCenter
                 .MergeCells = True
                 .FormulaR1C1 = (sut Mod 3) + Int(sut / 3)
              End With
            [COLOR="Red"][B]If sut >= 16380 Then
            k = k + 1
            Set NewSh = Sheets.Add(After:=Sheets(Sheets.Count))
            NewSh.Name = "Kombinasyon-" & k
            Sheets("Kombinasyon-" & k).Select
            sut = 1
            End If[/B][/COLOR]
       For iii = 0 To mynum
          Cells(iii + 2, sut) = i: Cells(iii + 2, sut + 1) = ii: Cells(iii + 2, sut + 2) = iii
       Next iii
       sut = sut + 3
   Next ii
Next i
Application.ScreenUpdating = True

End Sub

Biraz uzun sürüyor ama iş görüyor :)
İlgilenenler için kodları ekledim.

Herkese iyi günler dilerim.
 
Sayın İrfancantr

Kodlar güzel olmuş ama sütunlar bittikçe yeni sayfaya devam ediyor.
Sanırım siz sütunlar dolunca alt satırdan devam etsin istemiştiniz.
Süre gerçekten 256 rakamında kasar.
ADO veritabanı ile daha kolay olur.
Dizi(a1,b1,c1/a2,b2,c2/a3,b3,c3/....) şeklinde 3 lü matrixte c değerleri sabit iken b0...B256 değerlerini tek hamlede değiştirecek bir kod aradım ama bulamadım.Bu yolla sanırım çok kısa sürede döngü tamamlanır.
 
Sayın İrfancantr

Kodlar güzel olmuş ama sütunlar bittikçe yeni sayfaya devam ediyor.
Sanırım siz sütunlar dolunca alt satırdan devam etsin istemiştiniz.
Süre gerçekten 256 rakamında kasar.
ADO veritabanı ile daha kolay olur.
Dizi(a1,b1,c1/a2,b2,c2/a3,b3,c3/....) şeklinde 3 lü matrixte c değerleri sabit iken b0...B256 değerlerini tek hamlede değiştirecek bir kod aradım ama bulamadım.Bu yolla sanırım çok kısa sürede döngü tamamlanır.

Evet farkındayım ama aklıma bu kadarı geldi :)
Epey kastığının farkındayım.Konu takibini bırakmış değilim, daha farklı bir kod önerisini bekliyor olacağım.
 
Geri
Üst