Liệt kê tất cả trường hợp xảy ra khi lấy mẫu ở mỗi cột

[hieug126]

Em chào mọi người, Em có một vấn đề trong Excel mong mọi người giúp đỡ như file đính kèm ạ
File em có 3 cột, mỗi cột có một số giá trị, yêu cầu cần lấy 1 giá trị bất kỳ ở mỗi cột rồi ghép lại với các cột kia, cho em hỏi có cách nào để liệt kê tất cả các trường hợp này không ạ
Em cám ơn!

 

[snow25]

Em chào mọi người, Em có một vấn đề trong Excel mong mọi người giúp đỡ như file đính kèm ạ
File em có 3 cột, mỗi cột có một số giá trị, yêu cầu cần lấy 1 giá trị bất kỳ ở mỗi cột rồi ghép lại với các cột kia, cho em hỏi có cách nào để liệt kê tất cả các trường hợp này không ạ
Em cám ơn!

Bạn thử.

Sub add()
    Dim arr, i As Long, j As Long, k As Long, kq, R As Long, L As Long, a As Long
    arr = Range("A3:C5").Value
    R = UBound(arr)
    L = UBound(arr, 2)
    ReDim kq(1 To R ^ 3, 1 To 2)
    For i = 1 To R
        For j = 1 To R
            For k = 1 To R
                 a = a + 1
                 kq(a, 1) = a
                 kq(a, 2) = arr(i, 1) & " " & arr(j, 2) & " " & arr(k, 3)
            Next k
       Next j
    Next i
      Range("G2:H1000").ClearContents
      If a Then Range("G2:H2").Resize(a).Value = kq
End Sub

 

[hieug126]

Mình làm theo code trên và đã thành công, Cám ơn bạn snow25 rất nhiều ạ
Phiền bạn thêm 1 tý, nếu trường hợp có 4 cột thì làm như thế nào ạ!

 

[snow25]

Mình làm theo code trên và đã thành công, Cám ơn bạn snow25 rất nhiều ạ
Phiền bạn thêm 1 tý, nếu trường hợp có 4 cột thì làm như thế nào ạ!

Bạn cho cái kết quả 4 cột của bạn mình xem được không.

 

[hieug126]

Bạn cho cái kết quả 4 cột của bạn mình xem được không.

À mình vừa mới làm đc rồi, mình k biết gì về vba cả nhưng dựa vào code của bạn mình cho bừa thêm 1 biến nữa thì ok ))), cám ơn bạn rất nhiều

code:
Sub add()
Dim arr, i As Long, j As Long, k As Long, m As Long, kq, R As Long, L As Long, a As Long
arr = Range("A35").Value
R = UBound(arr)
L = UBound(arr, 2)
ReDim kq(1 To R ^ 4, 1 To 2)
For i = 1 To R
For j = 1 To R
For k = 1 To R
For m = 1 To R
a = a + 1
kq(a, 1) = a
kq(a, 2) = arr(i, 1) & " " & arr(j, 2) & " " & arr(k, 3) & " " & arr(m, 4)
Next m
Next k
Next j
Next i
Range("G2:H1000").ClearContents
If a Then Range("G2:H2").Resize(a).Value = kq
End Sub