• DİKKAT

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

Lİstbox'tan Userforma'a Rastgele Veri Aktarma

B

BedriA

Katılım
3 Haziran 2017
Mesajlar
797
Excel Vers. ve Dili
2007, 32
Değerli Arkadaşlar,

Ekteki örnekten daha iyi anlaşılacağı üzere, listbox'tan userforma rastgele bir veri getirmek istiyorum.

Yardımcı olacak arkadaşlara şimdiden teşekkür ederim.
 

Ekli dosyalar

userfor1ma ait kodlar

Kod: 
Private Sub CommandButton1_Click()

Set S1 = Worksheets("sayfa1")
sayi = UserForm1.ListBox1.ListCount

ReDim sayilar(sayi)
Dim Satir As Integer
For j = 1 To sayi
atla:
Randomize
Satir = Int((Rnd * sayi) + 1)
For m = 1 To sayi
If Satir = sayilar(m) Then
GoTo atla
End If
Next
sayilar(j) = Satir
'Cells(j, 3).Value = Satir
Next

a = sayilar(1) + 1


Adres = Worksheets("sayfa1").Cells(a, 1).Address
Dim Picture As Object
For Each Picture In S1.Shapes

If TypeName(S1.Shapes(Picture.Name).OLEFormat.Object) = "Picture" Then
yer = S1.Cells(Picture.BottomRightCell.Row, Picture.BottomRightCell.Column).Address

If yer = Adres Then
MsgBox Picture.BottomRightCell.Row
sut = Picture.BottomRightCell.Row

S1.Shapes(Picture.Name).Select
S1.Shapes(Picture.Name).CopyPicture

UserForm2.Image1.Picture = PastePicture
UserForm2.TextBox7.Text = Cells(sut, "h")
UserForm2.TextBox2.Text = Cells(sut, "c")
UserForm2.TextBox3.Text = Cells(sut, "d")
UserForm2.TextBox4.Text = Cells(sut, "e")
UserForm2.TextBox5.Text = Cells(sut, "f")
UserForm2.TextBox6.Text = Cells(sut, "g")
UserForm2.Show
Exit For
End If
End If

Next Picture


End Sub



Private Sub UserForm_Initialize()
With UserForm1.ListBox1
.ColumnCount = 9
.ColumnWidths = "70;400;1;1;1;1;1;1;20"
.ColumnHeads = True
son = Worksheets("Sayfa1").Cells(Rows.Count, "b").End(3).Row

.RowSource = "Sayfa1!a2:" & Worksheets("Sayfa1").Cells(son, "I").Address
End With
End Sub


Private Sub ListBox1_Click()


Set S1 = Worksheets("sayfa1")
MsgBox ListBox1.ListIndex + 2

a = ListBox1.ListIndex + 2

Adres = Worksheets("sayfa1").Cells(a, 1).Address
Dim Picture As Object
For Each Picture In S1.Shapes

If TypeName(S1.Shapes(Picture.Name).OLEFormat.Object) = "Picture" Then
yer = S1.Cells(Picture.BottomRightCell.Row, Picture.BottomRightCell.Column).Address

If yer = Adres Then
sut = Picture.BottomRightCell.Row

S1.Shapes(Picture.Name).Select
S1.Shapes(Picture.Name).CopyPicture

UserForm2.Image1.Picture = PastePicture
UserForm2.TextBox7.Text = Cells(sut, "h")
UserForm2.TextBox2.Text = Cells(sut, "c")
UserForm2.TextBox3.Text = Cells(sut, "d")
UserForm2.TextBox4.Text = Cells(sut, "e")
UserForm2.TextBox5.Text = Cells(sut, "f")
UserForm2.TextBox6.Text = Cells(sut, "g")
UserForm2.Show
Exit For
End If
End If

Next Picture


End Sub
 
halit3' Alıntı:
userfor1ma ait kodlar

Kod: 
Private Sub CommandButton1_Click()

Set S1 = Worksheets("sayfa1")
sayi = UserForm1.ListBox1.ListCount

ReDim sayilar(sayi)
Dim Satir As Integer
For j = 1 To sayi
atla:
Randomize
Satir = Int((Rnd * sayi) + 1)
For m = 1 To sayi
If Satir = sayilar(m) Then
GoTo atla
End If
Next
sayilar(j) = Satir
'Cells(j, 3).Value = Satir
Next

a = sayilar(1) + 1


Adres = Worksheets("sayfa1").Cells(a, 1).Address
Dim Picture As Object
For Each Picture In S1.Shapes

If TypeName(S1.Shapes(Picture.Name).OLEFormat.Object) = "Picture" Then
yer = S1.Cells(Picture.BottomRightCell.Row, Picture.BottomRightCell.Column).Address

If yer = Adres Then
MsgBox Picture.BottomRightCell.Row
sut = Picture.BottomRightCell.Row

S1.Shapes(Picture.Name).Select
S1.Shapes(Picture.Name).CopyPicture

UserForm2.Image1.Picture = PastePicture
UserForm2.TextBox7.Text = Cells(sut, "h")
UserForm2.TextBox2.Text = Cells(sut, "c")
UserForm2.TextBox3.Text = Cells(sut, "d")
UserForm2.TextBox4.Text = Cells(sut, "e")
UserForm2.TextBox5.Text = Cells(sut, "f")
UserForm2.TextBox6.Text = Cells(sut, "g")
UserForm2.Show
Exit For
End If
End If

Next Picture


End Sub



Private Sub UserForm_Initialize()
With UserForm1.ListBox1
.ColumnCount = 9
.ColumnWidths = "70;400;1;1;1;1;1;1;20"
.ColumnHeads = True
son = Worksheets("Sayfa1").Cells(Rows.Count, "b").End(3).Row

.RowSource = "Sayfa1!a2:" & Worksheets("Sayfa1").Cells(son, "I").Address
End With
End Sub


Private Sub ListBox1_Click()


Set S1 = Worksheets("sayfa1")
MsgBox ListBox1.ListIndex + 2

a = ListBox1.ListIndex + 2

Adres = Worksheets("sayfa1").Cells(a, 1).Address
Dim Picture As Object
For Each Picture In S1.Shapes

If TypeName(S1.Shapes(Picture.Name).OLEFormat.Object) = "Picture" Then
yer = S1.Cells(Picture.BottomRightCell.Row, Picture.BottomRightCell.Column).Address

If yer = Adres Then
sut = Picture.BottomRightCell.Row

S1.Shapes(Picture.Name).Select
S1.Shapes(Picture.Name).CopyPicture

UserForm2.Image1.Picture = PastePicture
UserForm2.TextBox7.Text = Cells(sut, "h")
UserForm2.TextBox2.Text = Cells(sut, "c")
UserForm2.TextBox3.Text = Cells(sut, "d")
UserForm2.TextBox4.Text = Cells(sut, "e")
UserForm2.TextBox5.Text = Cells(sut, "f")
UserForm2.TextBox6.Text = Cells(sut, "g")
UserForm2.Show
Exit For
End If
End If

Next Picture


End Sub
Genişletmek için tıkla ...

Halit Hocam,

Dener denemez geri dönüş yapacağım.

Çok teşekkürler.
 
Halit Hocam,

Kod çalışıyor. Yalnız şunu merak etim. Rastgele seçimin bir kriteri var mı?
Diyelim ki 100 tane data var. Rastgele seçimde aynı data ikinci seferde gelebilir mi?

Çok ama çok sağolun.
 
ne kadar data varsa o kadar ihtimalle aynı veri gelebilir diyelimki 3 data var seçimde 1/3 olacaktır.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst