Nhờ mọi người sửa đoạn code để ghép vị trí giúp em với ạ.

[zPeterPan]

Em chào tất cả thầy cô và anh chị em trên diễn đàn, file của em ngày trước được thầy Ba Tê trợ giúp file này để ghép 2 số. Em đã biên tập lại và giờ muốn ghép 3 vị trí thì thêm vòng lặp nhưng báo lỗi nhờ mọi người sửa giúp em với ạ ( vì em không chuyên về viết code ạ ), em xin cảm ơn ạ.
Kết quả em mong muốn đây ạ ( em gõ tay ví dụ vài dòng ghép ạ):

Sub GhepViTri_3So()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Dim sArr(), dArr(), tArr(), Tmp As Variant, fDay As Date, eDay As Date
Dim i As Long, J1 As Long, k As Long, J2 As Long, J3 As Long, R As Long, R2 As Long, CoL As Long, CoLs As Long, xCol As Long
    CoLs = 82  ' So ky tu trong 1 cell, cot C trong sheet1'
With Sheet1
    sArr = .Range("C4", .Range("C4").End(xlDown)).Value
    R = UBound(sArr)    'So dong cua mang sArr'
ReDim dArr(1 To R, 1 To CoLs)
    CoLs = 86
    sArr = .Range("A2").Resize(R + 2, CoLs).Value
    R = UBound(sArr)
End With
With Sheet2
    .Range("B2:QQQ11344").ClearContents
    fDay = .Range("C1").Value
    eDay = .Range("H1").Value
    xCol = eDay - fDay + 20 'So cot trong sheet2'
    ReDim dArr(1 To 82 * 81 + 1, 1 To xCol)
    CoL = 1
    For i = 2 To R
        If sArr(i, 2) >= fDay Then
            If sArr(i, 2) <= eDay Then
                CoL = CoL + 1
                k = 1
                For J1 = 5 To CoLs
                    For J2 = 5 To CoLs
                        For J3 = 5 To CoLs
                        If J1 <> J2 & J2 <> J3 & J1 <> J3 Then
                            dArr(1, CoL) = sArr(i, 2)
                            k = k + 1
                            If CoL = 3 Then dArr(k, 1) = sArr(2, J1) & "-" & sArr(2, J2) & "-" & sArr(2, J3)
                            dArr(k, CoL) = sArr(i, J1) & sArr(i, J2) & sArr(i, J3)
                        End If
                        Next J3
                    Next J2
                Next J1
                If sArr(i, 2) > eDay Then Exit For
            End If
          End If
    Next i
    .Range("A2:A12000").Resize(, 10000).ClearContents
    .Range("A2").Resize(k, xCol) = dArr
End With
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub

 

[zPeterPan]

Cái này có vẻ không giống như trong file bài 1:
Tại A3 sheet "GhepViTri" = VT1-VT2-VT1. Vậy cái nào là A, cái nào là B, cái nào là C

thì em ví dụ ( ABC ) thôi mà, giả xử : VT1=A, VT2=B, VT3=C . Cách ghép theo lần lượt mà anh

 

[batman1]

thì em ví dụ ( ABC ) thôi mà, giả xử : VT1=A, VT2=B, VT3=C . Cách ghép theo lần lượt mà anh

Chắc ý là thế này ...
Bạn liệt kê ra 6 khả năng ABC, ACB, BAC, BCA, CAB, CBA. Trong mỗi khả năng A, B, C không lặp lại. Trong khi đó VT1-VT2-VT1 là ABA, A bị lặp lại. Người ta thấy khó hiểu là thế.
Giải thích lại cho người ta hiểu ý mình thôi.

 

[zPeterPan]

Chắc ý là thế này ...
Bạn liệt kê ra 6 khả năng ABC, ACB, BAC, BCA, CAB, CBA. Trong mỗi khả năng A, B, C không lặp lại. Trong khi đó VT1-VT2-VT1 là ABA, A bị lặp lại. Người ta thấy khó hiểu là thế.
Giải thích lại cho người ta hiểu ý mình thôi.

đúng rồi, em thiếu cặp ABA nên là cứ thấy lủng củng, cảm ơn bác.