• DİKKAT

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

aralıktan kriterlere göre rastgele seçilen değerleri başka sütuna getirmek?

K

KMLZDMR

Katılım
9 Nisan 2015
Mesajlar
494
Excel Vers. ve Dili
2003 TÜRKÇE EXCEL
Sayın formdaşlar,
aralıktan kriterlere göre rastgele seçilen değerleri başka sütuna getirmek için gerekli formüllere ihtiyacım var. (Excel 2003) dosya ektedir.

B2:B29 aralığındaki değerlerden olmak üzere
1-) G5 hücresindeki değerden büyük olan değerler arasından rastgele G6 hücresinde belirlenen adetteki değerleri rastgele seçip C sütununa getirmesi gerekli. Aynı olan değerler gelirse en değer sayısı kadar gelmesi gerekecektir.
Örneğin 250 değeri 2 adet var c sütununa rastgele de olsa en fazla 2 adet 250 gelmesi gerekli.

Saygılarımla.
 

Ekli dosyalar

Merhaba.

Formül kullanarak rastgele sayı üretildiğinde bu sayılar sabit olarak durmaz.
Sayfada herhangi bir hücredeki işlem sırasında hesaplama yapıldığı anda,
sayfadaki tüm formüller yeniden hesaplanacağından üretilen sayılar tekrar değişecektir.

Bu nedenle istediğiniz RASTGELE işlemi için makro kullanmak gerekir.

Ancak; rastgele yerine belli kritere göre (alt limit değerinden büyük olmak koşuluyla büyüklük sırasına göre azalan gibi)
listeden veri çağrılmasını tercih ederseniz aşağıdaki formülü dizi formülüne dönüştürerek kullanabilirsiniz.
Formüldeki BÜYÜK işlevini KÜÇÜK olarak değiştirirseniz değerler artan olarak listelenir.

Yapılacak işlem; formülü C2 hücresine yapıştırın, C2 hücresi seçiliyken F2 tuşuna basın, CTRL ve SHIFT tuşları basılı durumdayken ENTER tuşuna basın.
Artık formül {....} gibi köşeli parantez arasına alınmış yani formül dizi formülüne dönüştürülmüştür. Formülü aşağı doğru kopyalayın.
.
Kod: 
=[COLOR="red"]EĞER[/COLOR]([COLOR="red"]SATIR[/COLOR](A1)>[COLOR="red"]EĞERSAY[/COLOR]($B$2:$B$29;">"&$G$5);"";[COLOR="red"]BÜYÜK[/COLOR]([COLOR="red"]EĞER[/COLOR]($B$2:$B$29>$G$5;$B$2:$B$29);[COLOR="Red"]SATIR[/COLOR](A1)))
Formülün 15 adet değer üretmesi için alt limit olarak kullanılacak sayıyının en fazla kaç olarak yazılabileceğini ise;
=BÜYÜK($B$2:$B$29;G6)-1 formülüyle bulabilirsiniz.
Bu formülün sonucu mevcut verilere göre 89 olur. Yani alt limit değeri en fazla 89 olmalıdır ki; 15 adet değer üretilebilsin.
.
 
Sayın Ömer Baran üstadım.Çok teşekkür ederim. Makro ile yapmak mümkün mü?
 
Tekrar merhaba.

-- Alt taraftan, uygulama istediğiniz sayfanın adına fareyle sağ tıklayıp KOD GÖRÜNTÜLEyi seçin,
açılan VBA ekranında sağdaki boş alana ayağıdaki kod'u yapıştırın.
-- Sayfaya bir düğme/şekil/metin kutusu yerleştirin, bu düğmeye fareyle sağ tıklayıp MAKRO ATAyı seçin,
açılan küçük ekranda RAST_LIMIT_LISTE'yi seçip işlemi onaylayın.
-- Bu düğmeye fareyle tıklayarak kod'u çalıştırabilirsiniz.
.
Kod: 
[B]Sub RAST_LIMIT_LISTE()[/B]
If [G5] < [B][COLOR="Blue"]0[/COLOR][/B] Or [G6] < 1 Or [G5] = "" Or [G6] = "" Then
    MsgBox "Alt limit veya adet bilgisi eksik/tutarsız.", vbCritical, "???  HATA  ???"
    Exit Sub
End If
altlimit = [G5]: adet = [G6]: ilk = 2: son = WorksheetFunction.Max([A:A]) + 1
Set wf = Application.WorksheetFunction
Range("C2:C" & son).ClearContents
If wf.CountIf(Range("B2:B" & son), ">" & altlimit) < adet Then
    MsgBox altlimit & "  sayısından büyük olmak üzere;" & vbLf & _
        adet & " adet sayı mevcut değil !...." & vbLf & vbLf & _
        "Ya G5 hücresindeki ALT LİMİT değerini düşürün" & vbLf & _
        "ya da G6 hücresindeki ADET sayısını düşürün", vbCritical, "???  HATA  ???"
    Exit Sub
End If
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
For sat = 2 To adet + 1
[B][COLOR="blue"]10: VBA.Randomize
s = Int((son - 1) * Rnd + 2)[/COLOR][/B]
    If Cells(s, "B") <= altlimit Or wf.CountIf(Range("B2:B" & son), Cells(s, "B")) < _
        wf.CountIf(Range("C2:C" & sat), Cells(s, "B")) + 1 Then GoTo 10
    Cells(sat, "C") = Cells(s, "B")
Next
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem tamamlandı", vbInformation, "..::.. Ömer BARAN ..::.."
[B]End Sub[/B]
 
Ofis 2003 de
Kod: 
WorksheetFunction.RandBetween
bu olay yordamı çalışmaz.

Alternatif kod

Kod: 
Sub rasgele_sec()


Dim Satir, sat, ekle, bas, bit, j, m, sayi
sayi = Cells(Rows.Count, "b").End(xlUp).Row
ReDim veri(sayi)
ReDim sayilar(sayi)

sat = 0
ekle = 1

bas = Cells(5, "g") + ekle
bit = Cells(6, "g") + ekle

If Val(bas) <= 0 Then Exit Sub
If Val(bit) <= 0 Then Exit Sub
If Val(bas) > Val(bit) Then Exit Sub

For i = bas To bit
sat = sat + 1
veri(sat) = Cells(i, "b").Value
Next

Range("C2:C29").ClearContents

For j = 1 To sat
atla:
Randomize
Satir = Int((Rnd * sat) + 1)
For m = 1 To sat
If Satir = sayilar(m) Then
GoTo atla
End If
Next

sayilar(j) = Satir
Cells(j + 1, "c").Value = veri(Satir)
Cells(j + 1, "e").Value = Satir

Next

End Sub
 
Sayın Ö. Baran Sayın Halit3 teşekkür ederim.

Sayın Ömer Baran üstadım, uyguladım makroyu çalıştırınca aşağıdaki uyarıyı aldım.Çözemedim.Nasıl yapabilirim.
Object doesn't support this property or method (Nesne, bu özelliği veya yöntemi desteklemez)

Sayın Halit3 makr çalıştı ancak sorunlar var.
Örneğin: G5 hücresi Alt limit: 1 ve G6 hücresinde Seçilecek satır değer adedi: 28 iken B sütunu satır sayısı 29 B sütununda 1 adet 3 sayısı olmasına rağmen makro çalışınca 3 sayısı 3 adet geldi (bu doğru değil), halbuki değer sayısını aşmaması ve 1 adet 3 gelmesi gerekirdi. Buna rağmen 2 sayısı 3 adet bulunmakta iken de 3 adet 2 sayısı geldi.(bu doğru)

her iki makro içinde de konuya tekrar bakmak mümkün mü?
 
Alternatif olsun,

Kod: 
Sub rastgele_secim()
Dim a(), b(), c(), i As Integer
Dim Ilk As Integer, Son As Integer
Dim j As Integer, Sayi As Integer
a = [B2:B29].Value
Ilk = [G5]
Son = [G6]
Sayi = Son - Ilk + 1
ReDim c(1 To Sayi)
ReDim b(1 To Sayi, 1 To 1)
    For i = 1 To Sayi
atla:
        c(i) = Int(Rnd * UBound(a)) + 1
        For j = 1 To i - 1
            If c(i) = c(j) Then GoTo atla
        Next j
        b(i, 1) = a(c(i), 1)
    Next i
[C2:C29].ClearContents
[C2].Resize(Sayi) = b
End Sub
 
Tekrar merhaba.

Önceki kod cevabımda değişiklik yaptım, sayfayı yenileyerek kontrol edin. (umanım yanlış yapmadım)
Sayın ÖZDEMİR'in belirttiği hususu ben de bilmiyordum öğrenmiş oldum, kendisine teşekkürler.

Değişen kısımları mavi renklendirdim.
.
 
Tam olarak anlayamadım nokta burası

Kod: 
[COLOR="Red"]G5 hücresindeki değerden büyük olan değerler arasından[/COLOR]
rastgele G6 hücresinde belirlenen adetteki değerleri
rastgele seçip C sütununa getirmesi gerekli.
Aynı olan değerler gelirse en değer sayısı kadar gelmesi gerekecektir.


Kod: 
Sub deneme()

Dim Satir, sat, ekle, bas, bit, j, m, sayi
sayi = Cells(Rows.Count, "b").End(xlUp).Row
ReDim veri(sayi)
ReDim sayilar(sayi)

sat = 0
ekle = 1

bas = Cells(5, "g") + ekle
bit = Cells(6, "g") + ekle

If Val(bas) <= 0 Then Exit Sub
If Val(bit) <= 0 Then Exit Sub
If Val(bas) > Val(bit) Then Exit Sub

For i = bas To bit
sat = sat + 1
veri(sat) = Cells(i, "b").Value
Next

Range("C2:C29").ClearContents

For j = 1 To sat
atla:
Randomize
Satir = Int((Rnd * sat) + 1)
For m = 1 To sat
If Satir = sayilar(m) Then
GoTo atla
End If
Next

sayilar(j) = Satir
Cells(j + 1, "c").Value = veri(Satir)
Cells(j + 1, "e").Value = Satir

Next

End Sub
 
Sayın Ömer Baran Üstad aklınıza sağlık.Teşekkür ederim.
Sayın Ziynettin teşekkür ederim.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst