KOMBİNASYON

GAZOZ_55 · 27 Eylül 2020

Sonuç sütununda yer alan sayıların birbiriyle 2'li, 3'lü ve 4'lü kombinasyonlarını yapmak istiyorum. Bunu VBA ile nasıl yaparız?

Ömer · 27 Eylül 2020

Merhaba

Forumda kombinasyon olarak arama yapınız.

19 sayısının 4 lü kombinasyonu listeleme

Mrblar iş yeri için 19 farklı sayının excelde 4 lü kombinasyonunu alt alta nasıl listelerim bir projeyle yardımcı olursanız sevinirim. örn: 1234 1235 1236 1237 2357 4852 gibi ,şimdiden teşekkürler

www.excel.web.tr

Kombinasyon sonucunu sayfalara yazdırabilirmiyiz

Selam Excelde kombinasyon sonucunu sayfalara yazdırabilirmiyiz örneğin 20 ismin 3 erli kombinasyonu 1140 adet oluyor VBA kodlarıyla veya başka bir yöntemle bu 1140 adet 3 erli ismi sayfaya/sayfalara yazdırabilirmiyiz

www.excel.web.tr

.

GAZOZ_55 · 27 Eylül 2020

Teşekkürler Ömer bey.

kulomer46 · 27 Eylül 2020

Merhaba

Alternatif çözüm olarak dosyanız Ek 'tedir.

Selamlar...

GAZOZ_55 · 27 Eylül 2020

Çok teşekkür ederim attığınız dosya için. Kombinasyonu kendiyle kombine olmayacak şekilde yapabilir miyiz?

kulomer46 · 27 Eylül 2020

Yaparız ama şu an çıkmam lazım.
Müsait olunca ekleyebiliriz.

Selamlar...

GAZOZ_55 · 27 Eylül 2020

Çok teşekkür ederim ilginiz için.

kulomer46 · 27 Eylül 2020

GAZOZ_55' Alıntı:
Çok teşekkür ederim attığınız dosya için. Kombinasyonu kendiyle kombine olmayacak şekilde yapabilir miyiz?

Merhaba

Yukardaki talebinizi biraz açabilirmisiniz.
Talebiniz birden çok yoruma müsait görünüyor.

Net olarak istediğiniz nasıl bir sonuç olsun.

Selamlar...

GAZOZ_55 · 27 Eylül 2020

Hocam mesela 10,20,30,40,50 olan bir data serisinde, ekte yer alan resimdeki gibi (10,20), (10,30), (10,40), (10,50) olacak. Yani seride (10,10) yok. Data serisindeki bir data kendiyle eşleşmeyecek.

kulomer46 · 28 Eylül 2020

GAZOZ_55' Alıntı:
Hocam mesela 10,20,30,40,50 olan bir data serisinde, ekte yer alan resimdeki gibi (10,20), (10,30), (10,40), (10,50) olacak. Yani seride (10,10) yok. Data serisindeki bir data kendiyle eşleşmeyecek.

Merhaba

Son taleplerinizi içeren dosya Ek 'tedir.

Selamlar...

kulomer46 · 28 Eylül 2020

Merhaba

Bir yukardaki #10 nolu mesajımda eklediğim dosyada bazı hatalar farkettim.
Dosyanın düzeltilmiş son hali Ek 'tedir.
Yukardaki dosyayı indiren arkadaşlar bu son eklediğim dosyayı kullansınlar.

Selamlar...

GAZOZ_55 · 29 Eylül 2020

Çok teşekkür ederim Ömer bey. Emeğinize sağlık.

eralpolat · 11 Kasım 2021

kulomer46' Alıntı:
Merhaba

Bir yukardaki #10 nolu mesajımda eklediğim dosyada bazı hatalar farkettim.
Dosyanın düzeltilmiş son hali Ek 'tedir.
Yukardaki dosyayı indiren arkadaşlar bu son eklediğim dosyayı kullansınlar.

Selamlar...

selamlar acaba vba kodunu paylaşma şansınız var mı?

kulomer46 · 11 Kasım 2021

eralpolat' Alıntı:
selamlar acaba vba kodunu paylaşma şansınız var mı?

Merhaba

Vba Kodu, Ekran Görüntüsü ve İlgili dosya Ek 'lenmiştir.

Selamlar...

Ekran Görüntüsü

İlgili Kod

Kod:

Sub Kombinasyon_Aktar()
'28.09.2020   11:30

zaman = Timer
Cells(6, 5) = ""
Cells(7, 5) = ""

Cells.Interior.Color = xlNone
Range("F1:P" & ActiveSheet.Rows.Count).ClearContents

satırsayısı = ActiveSheet.Rows.Count

    Range("F1:G1").Merge
    Range("I1:K1").Merge
    Range("M1:P1").Merge
    Range("E7:E9").Merge
    Range("E7:E9").WrapText = True
    Range("E7:E9").Font.Size = 12

Cells(1, 6) = "2 'li Kombinasyon"
Cells(1, 9) = "3 'lü Kombinasyon"
Cells(1, 13) = "4 'lü Kombinasyon"


Range("F1").Select

DoEvents

timer1 = Timer
Do While Timer - timer1 < 0.3
Loop

Application.ScreenUpdating = False

DoEvents
sona = Cells(Rows.Count, 1).End(3).Row
Cells(6, 5) = "Eleman Sayısı :  " & sona - 1
Cells(6, 5).Font.Bold = True

Cells(1, 1).Interior.Color = RGB(255, 192, 0)
Range(Cells(2, 1), Cells(sona, 1)).Interior.Color = RGB(255, 230, 153)

ReDim dizi(sona)

For i = 1 To sona
   
    dizi(i) = Cells(i, 1)

Next

'Cells(1, 6) = "2 'li Kombinasyon"
Cells(7, 5) = "2 'li Kombinasyon Üzerinde Çalışıyorum"
s2 = s2 + 1

For i = 2 To sona
    For j = i + 1 To sona
       
            If s2 > satırsayısı Then
           
                Application.ScreenUpdating = True
                Cells(7, 5) = "2 'li Kombinasyon Çözümü" & Chr(10) & "Toplam Satır Sayısını Aştı." & Chr(10) & "Geçen Süre : " & Int(Timer - zaman) + 1 & "  Sn."
                Cells(1, 6) = "2 'li Kombinasyon" & Chr(10) & " Şu ana Kadar " & s2 - 1 & " Adet"
                Cells(1, 6).Interior.Color = RGB(146, 208, 80)
               
                Range(Cells(2, 13), Cells(satırsayısı, 16)).Interior.Color = RGB(255, 230, 153)
                MsgBox "Çözüm Toplam Satır Sayısını  (" & ActiveSheet.Rows.Count & ") Aştı." & Chr(10) _
                & Chr(10) & "Listeleme Sonlandırıldı" & Chr(10) & Chr(10) _
                & "İşlem Süresi :   " & Int(Timer - zaman) + 1 & "  Sn."
                Exit Sub
           
            End If
   
            s2 = s2 + 1
            Cells(s2, 6) = dizi(i)
            Cells(s2, 7) = dizi(j)
         
    Next
Next
Cells(1, 6) = "2 'li Kombinasyon" & Chr(10) & s2 - 1 & " Adet"
Cells(7, 5) = "3 'lü Kombinasyon Üzerinde Çalışıyorum"

Cells(1, 6).Interior.Color = RGB(255, 192, 0)
Range(Cells(2, 6), Cells(s2, 7)).Interior.Color = RGB(255, 230, 153)


Application.ScreenUpdating = True

DoEvents
timer1 = Timer
Do While Timer - timer1 < 0.1
Loop
DoEvents

Application.ScreenUpdating = False

'Cells(1, 9) = "3 'lü Kombinasyon"
'Cells(7, 5) = "3 'lü Kombinasyon Üzerinde Çalışıyorum"
s3 = s3 + 1

For i = 2 To sona
    For j = i + 1 To sona
        For p = j + 1 To sona
       
                If s3 > satırsayısı Then
               
                    Application.ScreenUpdating = True
                    Cells(7, 5) = "3 'lü Kombinasyon Çözümü" & Chr(10) & "Toplam Satır Sayısını Aştı." & Chr(10) & "Geçen Süre : " & Int(Timer - zaman) + 1 & "  Sn."
                    Cells(1, 9) = "3 'lü Kombinasyon" & Chr(10) & " Şu ana Kadar " & s3 - 1 & " Adet"
                    Cells(1, 9).Interior.Color = RGB(146, 208, 80)
                   
                    Range(Cells(2, 13), Cells(satırsayısı, 16)).Interior.Color = RGB(255, 230, 153)
                    MsgBox "Çözüm Toplam Satır Sayısını  (" & ActiveSheet.Rows.Count & ") Aştı." & Chr(10) _
                    & Chr(10) & "Listeleme Sonlandırıldı" & Chr(10) & Chr(10) _
                    & "İşlem Süresi :   " & Int(Timer - zaman) + 1 & "  Sn."
                    Exit Sub
               
                End If
   
                s3 = s3 + 1
                Cells(s3, 9) = dizi(i)
                Cells(s3, 10) = dizi(j)
                Cells(s3, 11) = dizi(p)
       
        Next
    Next
Next
Cells(1, 9) = "3 'lü Kombinasyon" & Chr(10) & s3 - 1 & " Adet"
Cells(7, 5) = "4 'lü Kombinasyon Üzerinde Çalışıyorum"

Cells(1, 9).Interior.Color = RGB(255, 192, 0)
Range(Cells(2, 9), Cells(s3, 11)).Interior.Color = RGB(255, 230, 153)


Application.ScreenUpdating = True

DoEvents

timer1 = Timer
Do While Timer - timer1 < 0.1
Loop

DoEvents

Application.ScreenUpdating = False

'Cells(1, 13) = "4 'lü Kombinasyon"

s4 = s4 + 1

For i = 2 To sona
    For j = i + 1 To sona
        For p = j + 1 To sona
            For d = p + 1 To sona
           
                    If s4 >= satırsayısı Then
                   
                        Application.ScreenUpdating = True
                        Cells(7, 5) = "4 'lü Kombinasyon Çözümü" & Chr(10) & "Toplam Satır Sayısını Aştı." & Chr(10) & "Geçen Süre : " & Int(Timer - zaman) + 1 & "  Sn."
                        Cells(1, 13) = "4 'lü Kombinasyon" & Chr(10) & " Şu ana Kadar " & s4 - 1 & " Adet"
                        Cells(1, 13).Interior.Color = RGB(146, 208, 80)
                                           
                        Range(Cells(2, 13), Cells(satırsayısı, 16)).Interior.Color = RGB(255, 230, 153)
                        MsgBox "Çözüm Toplam Satır Sayısını  (" & ActiveSheet.Rows.Count & ") Aştı." & Chr(10) _
                        & Chr(10) & "Listeleme Sonlandırıldı" & Chr(10) & Chr(10) _
                        & "İşlem Süresi :   " & Int(Timer - zaman) + 1 & "  Sn."
                        Exit Sub
                   
                    End If
           
                    s4 = s4 + 1
                    Cells(s4, 13) = dizi(i)
                    Cells(s4, 14) = dizi(j)
                    Cells(s4, 15) = dizi(p)
                    Cells(s4, 16) = dizi(d)
           
            Next
        Next
    Next
Next
Cells(1, 13) = "4 'lü Kombinasyon" & Chr(10) & s4 - 1 & " Adet"

Cells(1, 13).Interior.Color = RGB(255, 192, 0)
Range(Cells(2, 13), Cells(s4, 16)).Interior.Color = RGB(255, 230, 153)

Rows("1:1").RowHeight = 49

Cells(7, 5) = "İşlem Tamam" & Chr(10) & "Geçen Süre : " & Int(Timer - zaman) + 1 & "  Sn."
Application.ScreenUpdating = True

MsgBox "İşlem Tamam" & Chr(10) & Chr(10) & "İşlem Süresi :   " & Int(Timer - zaman) + 1 & "  Sn.", , "İŞLEM"

End Sub

DOSYA_KOMBINASYON28.09.2020yenisi.xlsm dosyasını indir - download

DOSYA_KOMBINASYON__28.09.2020__yenisi.xlsm dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

KOMBİNASYON

GAZOZ_55

Ekli dosyalar

Ömer

Moderatör

19 sayısının 4 lü kombinasyonu listeleme

Kombinasyon sonucunu sayfalara yazdırabilirmiyiz

GAZOZ_55

kulomer46

Ekli dosyalar

GAZOZ_55

kulomer46

GAZOZ_55

kulomer46

GAZOZ_55

Ekli dosyalar

kulomer46

Ekli dosyalar

kulomer46

Ekli dosyalar

GAZOZ_55

eralpolat

kulomer46

DOSYA_KOMBINASYON28.09.2020yenisi.xlsm dosyasını indir - download

Ekli dosyalar