aynı olan değeri atlama

[faiktek]

ekteki dosyada A,B,C,D,E,F sütünlarındaki sayıların herbirinden birer tane alarak oluşturabilecek sayıları H sütununa yazdırmak istidim ancak bir şartım var. oluşturalacak 6 basamaklı sayıların rakamları birbirinden farklı olacak. bunu nasıl saglarım.

 

[Ferhat Pazarçevirdi]

ancak bir şartım var. oluşturalacak 6 basamaklı sayıların rakamları birbirinden farklı olacak

Bu cümlenizi tam olarak anlayamadım. "Sayıların rakamları birbirinden farklı olacak" demek ne demek?

Eğer, oluşturulan sayılar, benzer (mükerrer) olmayacak diyorsanız, verdiğiniz örnek sayı dizileri ile benzer sayı üretmek zaten mümkün değil. Eğer bir dizide bir elemandan birden fazla sayıda olsaydı, dediğimiz doğru olurdu. Yani A sütunundaki sayılar (1,2,3,4) değil de (1,1,2,2) şeklinde olsaydı ....

Aşağıdaki kod bu mantıkla ele alınmıştır.

Sub Deneme1()
Dim a%, b%, c%, d%, e%, f%, son%
Range("H:H").ClearContents
For a = Cells(1, 1) To Cells(Cells(65536, 1).End(xlUp).Row, 1)
    For b = Cells(1, 2) To Cells(Cells(65536, 2).End(xlUp).Row, 2)
        For c = Cells(1, 3) To Cells(Cells(65536, 3).End(xlUp).Row, 3)
            For d = Cells(1, 4) To Cells(Cells(65536, 4).End(xlUp).Row, 4)
                For e = Cells(1, 5) To Cells(Cells(65536, 5).End(xlUp).Row, 5)
                    For f = Cells(1, 6) To Cells(Cells(65536, 6).End(xlUp).Row, 6)
                        If Application.WorksheetFunction.CountIf(Range("H:H"), a & b & c & d & e & f) = 0 Then
                           If Cells(65536, 8).End(xlUp).Row <> 65536 Then
                              Cells(Cells(65536, 8).End(xlUp).Row + 1, 8) = a & b & c & d & e & f
                           Else
                              Cells(Cells(65536, 9).End(xlUp).Row + 1, 8) = a & b & c & d & e & f
                           End If
                        End If
                    Next
                Next
            Next
        Next
    Next
Next
End Sub