Kombinasyon ile ilgili yardımınızı bekliyorum.

[ahmetxaksoy]

Arkadaşlar öncelikle yardımlarınız için şimdiden teşekkürler.

ekte gönderdiğim dosya içinde (zaten gönderdiğim dosyayı excel.web.tr'den indirdim) kendime göre güncelledim fakat eksik kaldığım kısımlar var bu kısımlarda sizlerden yardım bekliyorum.


ekteki dosya içerisinde tarif ettim arkadaşlar sorunlu yerleri.

YUKARDA Kİ GİBİ DIŞARDAN EN KÜÇÜK VE EN BÜYÜK DEĞERLERİ GİREBİLECEĞİM,BİR TABLO OLUŞTURMAK İSTİYORUM	
GİRDİĞİM BU DEĞERLER ARASINDA Kİ KOMBİNASYONLARI BANA ÇIKARMASINI İSTİYORUM.	
A STÜNUNDA 18. SATIRA KADAR DEĞİL İSTEDİĞİM SATIRA KADAR DEĞER GİREBİLMEK İSTİYORUM.	
DIŞARDAN KOMBİNASYON SAYISINA DA MÜDAHALE EDEBİLMEK İSTİYORUM.	
MEVCUT DURUMDA ŞU ANDA 3 VE 4 KOMBİNASYON YAPIYOR SİSTEM.	
YAPILAN KOMBİNASYONLARIN SONUCUNDA SAPMA DEĞERLERİ ARASINDA EN KÜÇÜK OLANLARI LİSTELEMEK İSTİYORUM.	
ÖRNEK VERİYORUM 1195 İLE 1205 ARASINDA YAPTIRDIĞIMIZ İŞLEMDE KESİN SONUÇ 1200 YANİ +-5 TOLERANS GİBİ 	
	
	
YADA SAĞDAKİ GİBİ OPTİMUM DEĞERİMİ GİRİP ARTI EKSİ TOLERANS DEĞERİMİ GİREBİLECEĞİM SİSTEM DE OLABİLİR.

 

[ahmetxaksoy]

şimdi tekrar güncelleme yaptım ikili üçlü ve dörtlü kombinasyon yapıyor manuel olarak makro panele aralık değeri yapabiliyorum fakat bunu otomatiğe çeviremiyorum..

 

[ahmetxaksoy]

Arkadaşlar biliyorum flood yapıyorum ama gerçekten yardıma ihtiyacım var.

 

[Korhan Ayhan]

Deneyin...

Private Sub CommandButton1_Click()
    ilk = Application.InputBox("Lütfen en küçük değeri giriniz!")
    son = Application.InputBox("Lütfen en büyük değeri giriniz!")
    If ilk = "" Or son = "" Then Exit Sub
    
    Range("B1:CC18").ClearContents
    sut = 2
    '----------- iki olasılıklı deneme
    For i = 1 To 18
        For j = i + 1 To 18
                toplam = Cells(i, "A").Value + Cells(j, "A").Value
                If Format(toplam, "####") >= Val(ilk) And Format(toplam, "####") <= Val(son) Then
                    Cells(i, sut).Value = 1
                    Cells(j, sut).Value = 1
                    sut = sut + 1
                                
                    End If
            Next
        Next
    
    
    '----------- üç olasılıklı deneme
    For i = 1 To 18
        For j = i + 1 To 18
            For k = j + 1 To 18
                toplam = Cells(i, "A").Value + Cells(j, "A").Value + Cells(k, "A").Value
                If Format(toplam, "####") >= Val(ilk) And Format(toplam, "####") <= Val(son) Then
                    Cells(i, sut).Value = 1
                    Cells(j, sut).Value = 1
                    Cells(k, sut).Value = 1
                    sut = sut + 1
                                
                    End If
            Next
        Next
    Next
    
    '---------- Dört oasılıklı deneme
    
    For i = 1 To 18
        For j = i + 1 To 18
            For k = j + 1 To 18
                For l = k + 1 To 18
                toplam = Cells(i, "A").Value + Cells(j, "A").Value + Cells(k, "A").Value + Cells(l, "A").Value
                If Format(toplam, "####") >= Val(ilk) And Format(toplam, "####") <= Val(son) Then
                    Cells(i, sut).Value = 1
                    Cells(j, sut).Value = 1
                    Cells(k, sut).Value = 1
                    Cells(l, sut).Value = 1
                    sut = sut + 1
                End If
                Next
            Next
        Next
    Next
End Sub

 

[ahmetxaksoy]

Deneyin...

Private Sub CommandButton1_Click()
    ilk = Application.InputBox("Lütfen en küçük değeri giriniz!")
    son = Application.InputBox("Lütfen en büyük değeri giriniz!")
    If ilk = "" Or son = "" Then Exit Sub
    
    Range("B1:CC18").ClearContents
    sut = 2
    '----------- iki olasılıklı deneme
    For i = 1 To 18
        For j = i + 1 To 18
                toplam = Cells(i, "A").Value + Cells(j, "A").Value
                If Format(toplam, "####") >= Val(ilk) And Format(toplam, "####") <= Val(son) Then
                    Cells(i, sut).Value = 1
                    Cells(j, sut).Value = 1
                    sut = sut + 1
                                
                    End If
            Next
        Next
    
    
    '----------- üç olasılıklı deneme
    For i = 1 To 18
        For j = i + 1 To 18
            For k = j + 1 To 18
                toplam = Cells(i, "A").Value + Cells(j, "A").Value + Cells(k, "A").Value
                If Format(toplam, "####") >= Val(ilk) And Format(toplam, "####") <= Val(son) Then
                    Cells(i, sut).Value = 1
                    Cells(j, sut).Value = 1
                    Cells(k, sut).Value = 1
                    sut = sut + 1
                                
                    End If
            Next
        Next
    Next
    
    '---------- Dört oasılıklı deneme
    
    For i = 1 To 18
        For j = i + 1 To 18
            For k = j + 1 To 18
                For l = k + 1 To 18
                toplam = Cells(i, "A").Value + Cells(j, "A").Value + Cells(k, "A").Value + Cells(l, "A").Value
                If Format(toplam, "####") >= Val(ilk) And Format(toplam, "####") <= Val(son) Then
                    Cells(i, sut).Value = 1
                    Cells(j, sut).Value = 1
                    Cells(k, sut).Value = 1
                    Cells(l, sut).Value = 1
                    sut = sut + 1
                End If
                Next
            Next
        Next
    Next
End Sub

ilginiz için teşekkürler Korhan bey.

 

[ahmetxaksoy]

Bir sorunum daha var. kombinasyon hesaplama işlemi yaptırdığımda aynı kombinasyonları tekrar ediyor. Aşağıya görselini ekledim. bunun önüne geçilebilir mi ?

Bir diğer sorunum ise şu

Örnek veriyorum bir kombinasyon yaptırmak istiyorum sayılarımız

50
100
150

Ulaşmak istediğim rakam ise 200 yaptırdığım kombinasyonda;

50+150 şeklinde çıkarıyor sadece

50+50+50+50 yada 50+50+100 şeklinde tekrarlı olarak vermiyor.