Bir sayfada bulunan metinleri belirlenen yere rastgele dağıtma

[splashsmlt]

Bilgisi ile yardımcı olabilecekler varsa. ekli excel de sayfa 1 deki sarı dolgulu hücrelere, sayfa 2 deki metin 88 e kadar olanlar içinde SEÇTİKLERİMİ rastgele dağıtabilecek bir kod üretebilir miyiz? sayfa 1 de rastgele dağıt butonu konup ona bastığımızda rastgele dağıtması mümkün mü?

Hata indir

Hata

www.dosyaupload.com

 

[Necdet]

Merhaba,

Bilgisi ile yardımcı olabilecekler varsa

Bu mesajın yukarıdaki kısma pek olmamış

Aşağıdaki kodları deneyiniz.

Public Sub SecimDagit()

Dim sec As Range
Dim hcr As Range
Dim arr As Variant
Dim i   As Long

Set sec = Application.InputBox("Sayfa2 den aktarılacak Hücreleri Seçiniz..", Type:=8)

ReDim arr(1 To sec.Count, 1 To 2)

For Each hcr In sec
    i = i + 1
    arr(i, 1) = hcr.Address
    arr(i, 2) = Rnd
Next hcr

arr = Array_Sort(arr, , 2, True, True)

i = 0

For Each hcr In Sayfa1.Range("A1:I20")
    If hcr.Interior.ColorIndex = 6 Then
        i = i + 1
        If i > sec.Count Then Exit For
        hcr = Sayfa2.Range(arr(i, 1))
    End If
Next hcr

End Sub

Public Function Array_Sort(ByRef sortArray As Variant, _
                           Optional firstRow As Long = 1, _
                           Optional searchCol As Integer = 1, _
                           Optional numericSort As Boolean = False, _
                           Optional ascendingOrder As Boolean = True) As Variant()

Dim temp As Variant
Dim lastRow As Long
Dim firstCol As Long
Dim lastCol As Long
Dim i As Long
Dim j As Long
Dim k As Long

lastRow = UBound(sortArray, 1)
firstCol = LBound(sortArray, 2)
lastCol = UBound(sortArray, 2)
For i = firstRow To lastRow - 1
    For j = i + 1 To lastRow
        If (numericSort And ascendingOrder And sortArray(i, searchCol) > sortArray(j, searchCol)) _
        Or (Not (numericSort) And ascendingOrder And StrComp(sortArray(i, searchCol), sortArray(j, searchCol)) = 1) _
        Or (numericSort And Not (ascendingOrder) And sortArray(i, searchCol) < sortArray(j, searchCol)) _
        Or (Not (numericSort) And Not (ascendingOrder) And StrComp(sortArray(i, searchCol), sortArray(j, searchCol)) = -1) Then
            For k = firstCol To lastCol
                temp = sortArray(j, k)
                sortArray(j, k) = sortArray(i, k)
                sortArray(i, k) = temp
            Next k
        End If
    Next j
Next i

Array_Sort = sortArray

End Function

 

[splashsmlt]

necdet hocam merhaba. yanlış bir iafade mi kullandım? iki kez okudum ama farkedemedim. bir de excel e koydum ama beceremedim çalıştırmayı ekli excel e koymanız uygun olur mu sizin için

 

[splashsmlt]

necdet hocam hallettim. elinize emeğinize sağlık