Sub Combin_Main()
Dim sArr(), Res() As String, iRnd() As Long, Res2() As String
Dim K As Long, S As Long, sRow As Long, N As Long, i As Long
Range("E1", Range("E1000010").End(xlUp)).ClearContents
Range("C4").ClearContents
sArr = Range("A1:A" & Range("A1000000").End(xlUp).Row).Value
N = UBound(sArr)
K = Range("C1").Value: S = Range("C2").Value
If S <= 0 Or K <= 0 Then MsgBox ("Phai nhap so vào 2 ô C1 và C2"): Exit Sub
If K > N Then MsgBox ("Giá tri K phai nho hon so dòng du lieu"): Exit Sub
sRow = WorksheetFunction.Combin(N, K)
Range("C4") = sRow
If sRow > 1000000 Then sRow = 1000000
If S > sRow Then S = sRow
iRnd = UniqueRand(sRow, S)
Call Combin(Res, sArr, K, iRnd(S))
ReDim Res2(1 To S, 1 To 1)
For i = 1 To S
Res2(i, 1) = Res(iRnd(i), 1)
Next i
Range("E1").Resize(S) = Res2
Erase Res
End Sub
Private Function UniqueRand(ByVal N As Long, ByVal K As Long) As Variant
Dim sArr() As Long, blArr() As Boolean, Res() As Long, i As Long, RndNum As Long
ReDim sArr(1 To N)
For i = 1 To N
sArr(i) = i
Next i
ReDim blArr(1 To N): ReDim Res(1 To K)
For i = 1 To K
RndNum = Int(N * Rnd() + 1)
blArr(sArr(RndNum)) = True
sArr(RndNum) = sArr(N)
N = N - 1
Next i
K = 0: N = UBound(sArr)
For i = 1 To N
If blArr(i) = True Then
K = K + 1: Res(K) = i
End If
Next i
UniqueRand = Res
End Function
Private Sub Combin(ByRef Res, ByVal sArr, ByVal K As Long, ByVal sRow As Long)
Dim iD() As Long, tmp() As String
Dim N As Long, i As Long, j As Long, q As Long
N = UBound(sArr): K = Range("C1").Value
ReDim Res(1 To sRow, 1 To 1)
ReDim iD(1 To K): ReDim tmp(1 To K)
For j = 1 To K
iD(j) = j: tmp(j) = sArr(j, 1)
Next j
Res(1, 1) = Join(tmp, " - ")
For i = 2 To sRow
For j = 1 To K - 1
If iD(j + 1) = N - K + j + 1 Then
iD(j) = iD(j) + 1
tmp(j) = sArr(iD(j), 1)
For q = j + 1 To K
iD(q) = iD(q - 1) + 1
tmp(q) = sArr(iD(q), 1)
Next q
Exit For
ElseIf j = K - 1 Then
iD(K) = iD(K) + 1
tmp(K) = sArr(iD(K), 1)
End If
Next j
Res(i, 1) = Join(tmp, " - ")
Next i
End Sub
