Đếm số tổ hợp theo điều kiện và in ra Danh sách,

Chia sẻ bởi:hands

★★★★★

‹ Nhờ hỗ trợ hàm dò tìm VLOOKUP... Tìm mã hàng hóa từ bảng 1... ›

Quảng cáo

Chào Anh/Chị,

Em có một bài toán nhờ Anh/Chị xử lý giúp ạ. Em có 4 Danh sách các Cổ đông, phần trăm cổ phần tương ứng trong 4 năm từ 2018 đến 2022. Vấn đề của em là em muốn chọn ngẫu nhiên 25% số cổ đông của từng năm (số nguyên, làm tròn xuống) với điệu kiện là các Cổ đông chọn ngẫu nhiên của năm 2018 đều có mặt trong danh sách các Cổ đông chọn ngẫu nhiên của năm 2019. Tương tự như vậy, 25% Cổ đông chọn ngẫu nhiên của năm 2019 đều có mặt trong danh sách 25% Cổ đông chọn ngẫu nhiên của năm 2020, and so on …
Anh/Chị chỉ giúp em dùng hàm nào để đếm được số lượng cách chọn với điều kiện như trên và có cách nào để in ra các bộ danh sách đó không.

Cảm ơn Anh/Chị nhiều, :):):)

Tạo sheet KQ lưu dữ liệu lọc. Chạy code XYZ

Option Explicit
Sub XYZ()
  Dim arr(), sR(), aRand, aRes(), tRes, res(), dic As Object
  Dim i&, r&, j&, c&
  Const N& = 4 '4 nam
  ReDim arr(1 To N):  ReDim sR(1 To N, 0 To 1): ReDim res(1 To N)
  Set dic = CreateObject("scripting.dictionary")

With Sheets("Shareholder#")
    For j = 1 To N
      arr(j) = .Range(.Cells(3, j * 4 - 2), .Cells(3, j * 4 - 1).End(xlDown)).Value
      sR(j, 0) = UBound(arr(j))
      r = Int(sR(j, 0) / 4)
      ReDim aRow(1 To r)
      ReDim aRes(1 To r, 1 To 3)
      res(j) = aRes
    Next j
  End With
'Loai cac Co Dong khong co o nam sau
  For j = N - 1 To 1 Step -1
    Call CoDong(dic, arr, sR, j)
  Next j
'Chon cac gia tri ngau nhien
  Randomize
  For j = 1 To N
    aRand = UniqueRand(sR(j, 0))
    For r = 1 To UBound(aRand)
      If arr(j)(aRand(r), 1) <> Empty Then
        For c = j To N
          sR(c, 1) = sR(c, 1) + 1
          res(c)(sR(c, 1), 2) = arr(c)(aRand(r), 1)
          res(c)(sR(c, 1), 3) = arr(c)(aRand(r), 2)
          arr(c)(aRand(r), 1) = Empty
        Next c
        If sR(j, 1) = UBound(res(j)) Then Exit For
      End If
    Next r
  Next j
'Xep thu tu ngau nhien
  tRes = res
  For j = 1 To N
    aRand = UniqueRand(UBound(res(j)))
    For r = 1 To UBound(aRand)
      res(j)(r, 1) = r
      res(j)(r, 2) = tRes(j)(aRand(r), 2)
      res(j)(r, 3) = tRes(j)(aRand(r), 3)
    Next r
  Next j
'Gan ket qua
  With Sheets("KQ")
    For j = 1 To N
      .Cells(3, j * 4 - 3).Resize(UBound(res(j)), 3) = res(j)
    Next j
  End With
End Sub

Function UniqueRand(ByVal N As Long) As Variant 'Mang Day so ngau nhien 1 to N
  Dim arr&(), i&, RndNum&, tmp&
  ReDim arr&(1 To N)
  'Randomize
  For i = 1 To N
    RndNum = Int(N * Rnd() + 1)
    If arr(RndNum) = 0 Then tmp = RndNum Else tmp = arr(RndNum)
    If arr(N) = 0 Then arr(RndNum) = N Else arr(RndNum) = arr(N)
    arr(N) = tmp
    N = N - 1
  Next i
  UniqueRand = arr
End Function

Private Sub CoDong(dic, arr, sR, j)  'Loai cac co dong khong co o nam sau
    Dim i&, k&
    For i = 1 To sR(j + 1, 0)
      dic(arr(j + 1)(i, 1)) = ""
    Next i
    For i = 1 To sR(j, 0)
      If dic.exists(arr(j)(i, 1)) Then
        k = k + 1
        arr(j)(k, 1) = arr(j)(i, 1)
        arr(j)(k, 2) = arr(j)(i, 2)
      End If
    Next i
    sR(j, 0) = k
    dic.RemoveAll
End Sub

Chào Anh,

Cảm ơn anh đã giải quyết giúp vấn đề của em. Còn vấn để đếm được bao nhiêu tổ hợp kết quả thì có cách nào không anh?

Thanks a lot,

Dùng xác suất cổ điển để đếm, dạng tích xác suất nầy khá phức tạp, hơn 40 năm không đụng tới nên không nhớ công thức /-*+/ /-*+/ /-*+/

www.giaiphapexcel.com/diendan/threads/%C4%90%E1%BA%BFm-s%E1%BB%91-t%E1%BB%95-h%E1%BB%A3p-theo-%C4%91i%E1%BB%81u-ki%E1%BB%87n-v%C3%A0-in-ra-danh-s%C3%A1ch.163779/