DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub n()
Dim a, b, c, d, e, f, z As Integer
Dim s As Long
s = 1
z = 3
For a = 1 To 12
For b = 1 To 12
For c = 1 To 12
For d = 1 To 12
For e = 1 To 12
For f = 1 To 12
If s >= 65535 Then
s = 1
z = z + 1
Else
Cells(s, z).Value = Cells(a, 1).Value & "-" & Cells(b, 1).Value & "-" & Cells(c, 1).Value & "-" & Cells(d, 1).Value & "-" & Cells(e, 1).Value & "-" & Cells(f, 1).Value
s = s + 1
End If
Next
Next
Next
Next
Next
Next
End Sub
Sub n()
Dim a, b, c, d, e, f, z As Integer
Dim s As Long
s = 1
z = 3
For a = 1 To 12
For b = 1 To 12
For c = 1 To 12
For d = 1 To 12
For e = 1 To 12
For f = 1 To 12
If s >= 65535 Then
s = 1
z = z + 1
Else
If Cells(a, 1).Value = Cells(b, 1).Value Or Cells(a, 1).Value = Cells(c, 1).Value Or Cells(a, 1).Value = Cells(d, 1).Value Or Cells(a, 1).Value = Cells(e, 1).Value Or Cells(a, 1).Value = Cells(f, 1).Value Then GoTo w
If Cells(b, 1).Value = Cells(c, 1).Value Or Cells(b, 1).Value = Cells(d, 1).Value Or Cells(b, 1).Value = Cells(e, 1).Value Or Cells(b, 1).Value = Cells(f, 1).Value Then GoTo w
If Cells(c, 1).Value = Cells(d, 1).Value Or Cells(c, 1).Value = Cells(e, 1).Value Or Cells(c, 1).Value = Cells(f, 1).Value Then GoTo w
If Cells(d, 1).Value = Cells(e, 1).Value Or Cells(d, 1).Value = Cells(f, 1).Value Then GoTo w
If Cells(e, 1).Value = Cells(f, 1).Value Then GoTo w
Cells(s, z).Value = Cells(a, 1).Value & "-" & Cells(b, 1).Value & "-" & Cells(c, 1).Value & "-" & Cells(d, 1).Value & "-" & Cells(e, 1).Value & "-" & Cells(f, 1).Value
s = s + 1
w:
End If
Next
Next
Next
Next
Next
Next
End Sub
Sub n()
Dim a, b, c, d, e, f, z, by1, by2, by3, by4, by5, by6 As Integer
Dim s As Long
s = 1
z = 3
For a = 1 To 12
For b = 1 To 12
For c = 1 To 12
For d = 1 To 12
For e = 1 To 12
For f = 1 To 12
If s >= 65535 Then
s = 1
z = z + 1
Else
If Cells(a, 1).Value = Cells(b, 1).Value Or Cells(a, 1).Value = Cells(c, 1).Value Or Cells(a, 1).Value = Cells(d, 1).Value Or Cells(a, 1).Value = Cells(e, 1).Value Or Cells(a, 1).Value = Cells(f, 1).Value Then GoTo w
If Cells(b, 1).Value = Cells(c, 1).Value Or Cells(b, 1).Value = Cells(d, 1).Value Or Cells(b, 1).Value = Cells(e, 1).Value Or Cells(b, 1).Value = Cells(f, 1).Value Then GoTo w
If Cells(c, 1).Value = Cells(d, 1).Value Or Cells(c, 1).Value = Cells(e, 1).Value Or Cells(c, 1).Value = Cells(f, 1).Value Then GoTo w
If Cells(d, 1).Value = Cells(e, 1).Value Or Cells(d, 1).Value = Cells(f, 1).Value Then GoTo w
If Cells(e, 1).Value = Cells(f, 1).Value Then GoTo w
Cells(100, 1).Value = Cells(a, 1).Value
Cells(101, 1).Value = Cells(b, 1).Value
Cells(102, 1).Value = Cells(c, 1).Value
Cells(103, 1).Value = Cells(d, 1).Value
Cells(104, 1).Value = Cells(e, 1).Value
Cells(105, 1).Value = Cells(f, 1).Value
by1 = WorksheetFunction.Large(Range("a100:a105"), 1)
by2 = WorksheetFunction.Large(Range("a100:a105"), 2)
by3 = WorksheetFunction.Large(Range("a100:a105"), 3)
by4 = WorksheetFunction.Large(Range("a100:a105"), 4)
by5 = WorksheetFunction.Large(Range("a100:a105"), 5)
by6 = WorksheetFunction.Large(Range("a100:a105"), 6)
sıra = by6 & "-" & by5 & "-" & by4 & "-" & by3 & "-" & by2 & "-" & by1
If WorksheetFunction.CountIf(Range("c1:c65535"), sıra) >= 1 Then GoTo w
Cells(s, z).Value = sıra
s = s + 1
w:
End If
Next
Next
Next
Next
Next
Next
End Sub