nereden buldugumu hatirlamiyorum. kaynak yok.
suradaki mevzu ile ayni amac icin kullanildi.
makrolar gelistirici sekmesinden kullaniliyor. default ayarda excel’de bu sekme kapali olarak geliyor. gelistirici sekmesini acmak icin suradan
asagidaki kod VB kodu (kodu ben yazmadim) - makro olarak kullaniyor: 1. sayfadaki 10 satiri shuffle ediyor. satir sayisi kod icinden editlenebilir.
calistirilabilir hale getirdigim dosya liste_karistirma_makro.xlsm (makro hotkey’i ctrl+r atadim)(makro’nun enable edilmesi gerekebilir)
Public Enum enCevap
enCevapEvet
enCevapHayır
End Enum
Sub Sütunları_Karıştır()
Dim Csf As Worksheet: Set Csf = ThisWorkbook.Worksheets("sayfa1")
Dim data As Variant
Dim snlTab() As Variant
Dim tabSnc() As Variant
With Csf
For sut = 1 To 6
snlTab = .Range(Cells(1, sut), Cells(10, sut))
'----------------
data = BenzersizRastgeleSayilar(10, 1, 10, enCevapHayır)
If TypeName(data) = "Boolean" Then
MsgBox "BenzersizRastgeleSayilar fonksiyonu için verdiğiniz KacAdetSayi, EnKucukSayi, EnBuyukSayi değerlerinden bir veya daha fazlası uyumsuzdur."
Exit Sub
End If
'----------------------------
For sat = 1 To 10
ii = ii + 1
ReDim Preserve tabSnc(1 To 1, 1 To ii)
tabSnc(1, ii) = snlTab(data(sat), 1)
Next sat
ii = 0
tabSnc = Application.Transpose(tabSnc)
.Range(Cells(1, sut), Cells(10, sut)) = Empty
.Range(Cells(1, sut), Cells(10, sut)) = tabSnc
Erase snlTab, tabSnc, data
Next sut
End With
Set Csf = Nothing
End Sub
Function BenzersizRastgeleSayilar(KacAdetSayi As Long, EnKucukSayi As Long, EnBuyukSayi As Long, Optional Sıralımı As enCevap) As Variant
'Benzersiz Rastgele Sayılar Üretir.
'Kullanımı Aşağıdaki gibidir
'Data = UniqueRandomNumbers(6, 1, 49)
Dim RandColl As Collection, varTemp() As Long
Dim k&, i&, j&
BenzersizRastgeleSayilar = False
If KacAdetSayi < 1 Then Exit Function
If EnKucukSayi > EnBuyukSayi Then Exit Function
If KacAdetSayi > (EnBuyukSayi - EnKucukSayi + 1) Then Exit Function
Set RandColl = New Collection
Randomize
Do
On Error Resume Next
i = CLng(Rnd * (EnBuyukSayi - EnKucukSayi) + EnKucukSayi)
RandColl.Add i, CStr(i)
On Error GoTo 0
Loop Until RandColl.Count = KacAdetSayi
ReDim varTemp(1 To KacAdetSayi)
For i = 1 To KacAdetSayi
varTemp(i) = RandColl(i)
Next i
Set RandColl = Nothing
If Sıralımı = enCevapEvet Then
'**************ripek********************
For i = 1 To KacAdetSayi - 1
For j = i + 1 To KacAdetSayi
If varTemp(i) > varTemp(j) Then
k = varTemp(i)
varTemp(i) = varTemp(j)
varTemp(j) = k
End If
Next j
Next i
'**************ripek********************
End If
BenzersizRastgeleSayilar = varTemp
Erase varTemp
k = 0: i = 0: j = 0
End Function