DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Option Explicit
Sub KARIŞTIR_AKTAR()
Dim Satır As Byte, Sütun As Byte, Hücre As Range
Range("E1:F3").ClearContents
BAŞLA:
Randomize
Satır = Int(Rnd() * 3 + 1)
Sütun = Int(Rnd() * 2 + 1)
If WorksheetFunction.CountIf(Range("E1:F3"), Cells(Satır, Sütun)) = 0 Then
For Each Hücre In Range("E1:F3")
If Hücre.Value = Empty Then
Hücre.Value = Cells(Satır, Sütun)
Exit For
End If
Next
If WorksheetFunction.CountA(Range("E1:F3")) > 0 Then GoTo BAŞLA
Else
If WorksheetFunction.CountA(Range("E1:F3")) <> 6 Then GoTo BAŞLA
End If
MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
Sub karistir()
Dim Sec(6)
[e1:f3].ClearContents
Randomize
For Each hcr In Range("a1:b3")
tekrar:
Sayi = Int((6 * Rnd) + 1)
If Sec(Sayi) <> "" Then GoTo tekrar
Sec(Sayi) = hcr
Next
For Each hcr2 In Range("e1:f3")
y = y + 1
Cells(hcr2.Row, hcr2.Column) = Sec(y)
Next
End Sub