Rastgele hücre seçmek

[muratgunay48]

Arkadaşlar sayın hocalarım, InputBox'a girdiğim sayı kadar değeri A sütunundan rastgele seçecek. Dosyayı başlangıcını yaptım ama devamını getiremedim.
Yardımcı olur musunuz?
Şimdiden teşekkür ederim.
Saygılarımla.

 

[Necdet]

Merhaba,
Chatcpt sağolsun, o yazdı ben biraz kurcaladım

Rastgele sayı adet seçerken ben 30 ile sınırlandırdım, siz bunu Rows.Count yapabilirsiniz ya da kendiniz değer verebilirsiniz.
Aşağıdaki kod BuÇalışma Kitabında yine WorkbookOpen da olacak.

Private Sub Workbook_Open()

    Dim a As Variant
    Dim arr As Variant
    
    arr = Array(Range("A1"), Range("A4"), Range("A10"), Range("A17"), Range("A24"))
    a = Application.InputBox("Hücre sayısı giriniz.", "Sayı", Type:=1)
    
    If a = False Then
        MsgBox "İşlemi iptal ettiniz"
        Exit Sub
    End If
    RastgeleHücreSec CInt(a)

End Sub

Aşağıdaki kodları bir modüle kopyalayınız.

Sub RastgeleHücreSec(numCellsToSelect As Integer)

    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim selectedCells As Range
    Dim i As Integer
    Dim sat As Long
    
    ' Çalışma sayfasını belirle
    Set ws = ThisWorkbook.Sheets("Sayfa1") ' Sayfa adını değiştirebilirsiniz
    
    ' Verilerin olduğu aralığı belirle
    Set rng = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
    
    ' Rastgele hücreleri seçmek için döngü
    For i = 1 To numCellsToSelect
        ' Rastgele bir hücre seç
        sat = Application.WorksheetFunction.RandBetween(1, 30)
        
        Set cell = rng.Cells(sat, "A")
        
        ' Seçilen hücreyi seçilen hücreler aralığına ekle
        If selectedCells Is Nothing Then
            Set selectedCells = cell
        Else
            Set selectedCells = Union(selectedCells, cell)
        End If
    Next i
    
    ' Seçilen hücrelere işlem yapabilirsiniz
    If Not selectedCells Is Nothing Then
        selectedCells.Select ' Seçili hücreleri seçili yapmak
        ' İşlemlerinizi buraya yazabilirsiniz
    End If
    
End Sub

 

[Necdet]

Geri dönüş olmamış, neden ki?

 

[muratgunay48]

Merhaba,
Chatcpt sağolsun, o yazdı ben biraz kurcaladım

Rastgele sayı adet seçerken ben 30 ile sınırlandırdım, siz bunu Rows.Count yapabilirsiniz ya da kendiniz değer verebilirsiniz.
Aşağıdaki kod BuÇalışma Kitabında yine WorkbookOpen da olacak.

Private Sub Workbook_Open()

    Dim a As Variant
    Dim arr As Variant
  
    arr = Array(Range("A1"), Range("A4"), Range("A10"), Range("A17"), Range("A24"))
    a = Application.InputBox("Hücre sayısı giriniz.", "Sayı", Type:=1)
  
    If a = False Then
        MsgBox "İşlemi iptal ettiniz"
        Exit Sub
    End If
    RastgeleHücreSec CInt(a)

End Sub

Aşağıdaki kodları bir modüle kopyalayınız.

Sub RastgeleHücreSec(numCellsToSelect As Integer)

    Dim ws As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim selectedCells As Range
    Dim i As Integer
    Dim sat As Long
  
    ' Çalışma sayfasını belirle
    Set ws = ThisWorkbook.Sheets("Sayfa1") ' Sayfa adını değiştirebilirsiniz
  
    ' Verilerin olduğu aralığı belirle
    Set rng = ws.Range("A1:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
  
    ' Rastgele hücreleri seçmek için döngü
    For i = 1 To numCellsToSelect
        ' Rastgele bir hücre seç
        sat = Application.WorksheetFunction.RandBetween(1, 30)
      
        Set cell = rng.Cells(sat, "A")
      
        ' Seçilen hücreyi seçilen hücreler aralığına ekle
        If selectedCells Is Nothing Then
            Set selectedCells = cell
        Else
            Set selectedCells = Union(selectedCells, cell)
        End If
    Next i
  
    ' Seçilen hücrelere işlem yapabilirsiniz
    If Not selectedCells Is Nothing Then
        selectedCells.Select ' Seçili hücreleri seçili yapmak
        ' İşlemlerinizi buraya yazabilirsiniz
    End If
  
End Sub

Hocam çok teşekkür ederim. Emeğinize sağlık. Va olun.

 

[muratgunay48]

Geri dönüş olmamış, neden ki?

Geri dönüş olmamış, neden ki?

Rica ederim hocam. 14 yıldır forumdayım. Geri dönüş yapmaz olur muyum? Asla öyle bir saygısızlığım olmaz. O gün yazdım. Gitmemesi muhtemelen benim hatam. Belki cevabı gönder butonuna basmadım ya da basamadım. Cevap metni yazdığım gibi duruyordu. Moderatörsünüz muhtemelen yazdığımı ama göndermediğimi görebilirsiniz.
Tekrar tekrar özür dilerim.