• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Rastgele Veri Aktarımı

Katılım
11 Temmuz 2009
Mesajlar
225
Excel Vers. ve Dili
Excel 2013 Türkçe (64 Bit)
Merhaba,

Ek örnekte olduğu gibi sayfa1 de bulunan 20 satır veriden 6 satırı (kullanılacak çalışmada max.12000 satır olabilecektir) bir makro yadımı ile rastgele seçilerek sayfa2 ye yazdırılabilirmi?(örnekteki gibi sütun başlıklarında da değişkenlik vardır)

Teşekkürler,
 

Ekli dosyalar

Merhaba,
Dosyanız ilişiktedir.
Kod:
Sub RastgeleVeriAktar()
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
MaxSayı = s1.[A65536].End(3).Row - 1
Randomize
For i = 2 To 7
10  Sayı = Int((MaxSayı * Rnd) + 1)
    If WorksheetFunction.CountIf(s2.Range("A:A"), Sayı) > 0 Then GoTo 10
    If Sayı = 1 Then GoTo 10
    s2.Range("A" & i) = Sayı
    Set Aranan = s1.Range("A:A").Find(Sayı, , xlValues, xlWhole)
    If Not Aranan Is Nothing Then
        With s2
            .Cells(i, 1).Value = s1.Cells(Sayı + 1, 1).Value
            .Cells(i, 2).Value = s1.Cells(Sayı + 1, 2).Value
            .Cells(i, 3).Value = s1.Cells(Sayı + 1, 3).Value
            .Cells(i, 4).Value = s1.Cells(Sayı + 1, 4).Value
            .Cells(i, 5).Value = s1.Cells(Sayı + 1, 5).Value
            .Cells(i, 6).Value = s1.Cells(Sayı + 1, 7).Value
            .Cells(i, 7).Value = s1.Cells(Sayı + 1, 8).Value
        End With
    End If
Next
MsgBox "Rastgele Veri Aktarımı Tamamlandı.", , "dEdE Başarılar Diler..."
End Sub
 

Ekli dosyalar

Üstadım,

İlgi ve emeğiniz için çok teşekkür ederim.İstediğim gibi olmuş.
Rica etsem, mümkün ise aşağıdaki kodları tabiri caiz ise satır satır açıklayabilirmisiniz.

MaxSayı = s1.[A65536].End(3).Row - 1
Randomize
For i = 2 To 7
10 Sayı = Int((MaxSayı * Rnd) + 1)
If WorksheetFunction.CountIf(s2.Range("A:A"), Sayı) > 0 Then GoTo 10
If Sayı = 1 Then GoTo 10
s2.Range("A" & i) = Sayı
Set Aranan = s1.Range("A:A").Find(Sayı, , xlValues, xlWhole)
If Not Aranan Is Nothing Then
 
Merhaba,
Açıklamak kod yazmaktan daha zor galiba.:)

MaxSayı = s1.[A65536].End(3).Row - 1
'Sayfa1 A sütununda kaç adet veri var ve ürtilecek en büyük rastgele sayı kac olacak
Randomize
'Sistemin her seferinde farklı sayı üretmesi için
For i = 2 To 7
' Altı kez döngü oluşturduk.(Altı satır istediğiniz için)
'Bir yerine iki ile başladık, diğer sayfadaki satır numarasınıda burada üretmiş olduk.

10 sayı = Int((MaxSayı * Rnd) + 1)
'Rasgele sayımızı ürettik
If WorksheetFunction.CountIf(s2.Range("A:A"), sayı) > 0 Then GoTo 10
'Aynı sayı daha önce üretimiş mi , üretildiyse geri dönüp yenibir sayı üretilmesini istedik.
If sayı = 1 Then GoTo 10
'üretilen sayı 1 ise geri dönüp yenibir sayı üretilmesini istedik.
s2.Range("A" & i) = sayı
'ikinci sayfaya sayıyı yazdık
Set Aranan = s1.Range("A:A").Find(sayı, , xlValues, xlWhole)
'Sayıyı 1. sayfada aradık.
If Not Aranan Is Nothing Then
'eğer bulundu ise; Aşağıdaki işlemleri yap dedik.[/
 
Merhaba,

Zahmet verdiğim için kusura bakmayınız lütfen, hakkınızı helal ediniz.
(Talebim "balık almak yerine balık tutmayı" öğrenme isteğimdendir:)

Çalışmalarınızda başarılar dilerim.Tekrar çok teşekkürler,
 
makroyu nasıl oluşturuyoruz nasıl açıyoruz beceremedim.saygılar
 
Geri
Üst