Chọn danh sách ngẫu nhiên không trùng nhau từ danh sách có sẵn (1 người xem)

[khoahoc78]

Ace giúp mình với chọn danh sách ngẫu ngiên từ danh sách có sẵn bằng công thức hoặc VBA

 

[SA_DQ]

Tạm thời bạn tham khảo file này

 

[ndu96081631]

Ace giúp mình với chọn danh sách ngẫu ngiên từ danh sách có sẵn bằng công thức hoặc VBA

Rảnh quá... làm chơi cái coi:

Sub Main()
  Dim aSrc, item
  Dim aDes1(1 To 5, 1 To 1), aDes2(1 To 6, 1 To 1)
  Dim idx As Long, lRs As Long, n As Long
  With Sheets("Nguon_DL")
    aSrc = .Range("B2:B1000").Value
    lRs = UBound(aSrc)
    Randomize
    Do
      idx = Int(Rnd * lRs) + 1
      item = aSrc(idx, 1)
      If Len(item) Then
        n = n + 1
        If n < 6 Then
          aDes1(n, 1) = item
        Else
          aDes2(n - 5, 1) = item
        End If
      End If
      aSrc(idx, 1) = aSrc(lRs, 1)
      aSrc(lRs, 1) = item
      lRs = lRs - 1
    Loop Until lRs <= 0 Or n >= 11
    .Range("C4:C8").Value = aDes1
    .Range("D4:D9").Value = aDes2
  End With
End Sub

-----------------------------

Tạm thời bạn tham khảo file này

Code của chị Yến hình như chạy hổng có đúng với dữ liệu của tác giả hen?
(xem code chị... hổng có hiểu luôn. Ẹc... Ẹc...)

 

[ChanhTQ@]

(2) Code của chị Yến hình như chạy hổng có đúng với dữ liệu của tác giả hen?
(1) Xem code chị... hổng có hiểu luôn. Ẹc... Ẹc...

(1) Đó là những dòng lệnh VBA của anh nông dân làm Code!
Nhìn mắt thường mới hiểu; Còn lấy kính viễn vọng ngó vũ trụ thì sao mà hiểu được!

(2) Chuyện này để tác giả kiểm chứng thêm

 

[Ba Tê]

Góp thêm 1 cái "Dic to" cho đủ màu mè:

Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), Rws As Long, CoL As Long, K As Long, R As Double, I As Long
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range([B2], [B2].End(xlDown)).Value
R = UBound(sArr, 1)
ReDim dArr(1 To 6, 1 To 2)
CoL = 1
Randomize
Do While K < 12
    I = Int((R * Rnd) + 1)
    If Not Dic.Exists(I) Then
        Dic.Add I, ""
        K = K + 1: Rws = Rws + 1
        dArr(Rws, CoL) = sArr(I, 1)
        If CoL = 1 And Rws = 5 Then
            CoL = 2: Rws = 0
        End If
    End If
Loop
[C6].Resize(6, 2) = dArr
Set Dic = Nothing
End Sub

 

[ndu96081631]

Góp thêm 1 cái "Dic to" cho đủ màu mè:

Public Sub GPE()
Dim Dic As Object, sArr(), dArr(), Rws As Long, CoL As Long, K As Long, R As Double, I As Long
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range([B2], [B2].End(xlDown)).Value
R = UBound(sArr, 1)
ReDim dArr(1 To 6, 1 To 2)
CoL = 1
Randomize
Do While K < 12
    I = Int((R * Rnd) + 1)
    If Not Dic.Exists(I) Then
        Dic.Add I, ""
        K = K + 1: Rws = Rws + 1
        dArr(Rws, CoL) = sArr(I, 1)
        If CoL = 1 And Rws = 5 Then
            CoL = 2: Rws = 0
        End If
    End If
Loop
[C6].Resize(6, 2) = dArr
Set Dic = Nothing
End Sub

Code này báo lỗi "Subscript out of range" anh Ba ơi (khi Col = 2 và Rws tăng lên 7)
Ngoài ra sẽ rơi vào vòng lập vô tận nếu số lượng dữ liệu nguồn không đủ 11 em

 

[Ba Tê]

Code này báo lỗi "Subscript out of range" anh Ba ơi (khi Col = 2 và Rws tăng lên 7)
Ngoài ra sẽ rơi vào vòng lập vô tận nếu số lượng dữ liệu nguồn không đủ 11 em

Code này báo lỗi "Subscript out of range" anh Ba ơi (khi Col = 2 và Rws tăng lên 7)

Sao khi viết xong nó không báo lỗi khi chạy thử, để bi giờ bị ndu... bắt giò nhỉ?
Híc!

Ngoài ra sẽ rơi vào vòng lập vô tận nếu số lượng dữ liệu nguồn không đủ 11 em

Vậy thì khi viết code phải "thủ thả" đầy đủ các tình huống cho "maythangngu"?
Hu hu....

Public Sub GPE()
On Error Resume Next
Dim Dic As Object, sArr(), dArr(), Rws As Long, CoL As Long, K As Long, R As Double, I As Long
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Range([B2], [B2].End(xlDown)).Value
R = UBound(sArr, 1)
If R < 11 Then
    MsgBox "Ma may! Ngu qua thi chet di."
    Exit Sub
Else
    ReDim dArr(1 To R, 1 To 2)
    CoL = 1
    Randomize
    Do While K < 11
        I = Int((R * Rnd) + 1)
        If Not Dic.Exists(I) Then
            Dic.Add I, ""
            K = K + 1: Rws = Rws + 1
            dArr(Rws, CoL) = sArr(I, 1)
            If CoL = 1 And Rws = 5 Then
                CoL = 2: Rws = 0
            End If
        End If
    Loop
    [C6].Resize(6, 2) = dArr
    Set Dic = Nothing
End If
End Sub

Uả! Ngày nay là ngày "Đại đoàn kết" mà ta? Mới đi dự "ĐĐK" ở ấp mình về mà. Hay là tại mình ngu?

 

[VetMini]

Sao khi viết xong nó không báo lỗi khi chạy thử, để bi giờ bị ndu... bắt giò nhỉ?
Híc!
...

Cách của ndu dùng là cách rút số lô tô (bingo). Số bị rút ra khỏi túi rồi thì bị loại luôn, không trở lại.
Cách của bác là cách không bỏ số, gặp trùng thì rút lại. Tuy trông đơn giản nhưng nó bị khuyết điểm là càng về sau càng bị rút lại nhiều. Theo lý thuyết, nếu lượng số nhiều thì xác suất bốc một số càng giảm, và có khả năng bị chạy vài tiếng đồng hồ sau mới tìm được số cuối cùng.

 

[Ba Tê]

Cách của ndu dùng là cách rút số lô tô (bingo). Số bị rút ra khỏi túi rồi thì bị loại luôn, không trở lại.
Cách của bác là cách không bỏ số, gặp trùng thì rút lại. Tuy trông đơn giản nhưng nó bị khuyết điểm là càng về sau càng bị rút lại nhiều. Theo lý thuyết, nếu lượng số nhiều thì xác suất bốc một số càng giảm, và có khả năng bị chạy vài tiếng đồng hồ sau mới tìm được số cuối cùng.

Híc!
Dự "Đại đoàn kết" về làm cho mình chẳng biết đâu là đâu.
"Xin lỗi đại ca em quá chén"!