Xin giúp đỡ tạo tổ hợp bằng VBA (1 người xem)

[peternhp29]

Xin chào ACE GiaiPhapExcel,

Nhờ AC giúp em tạo tổ hợp có miêu tả như trong file đính kèm.

Em có 1 cột dọc là số LÒ, 1 cột ngang là số KHUÔN, tương ứng với số lò và khuôn là 1 giá trị. Nhờ anh chị viết dùm đoạn code để lấy ra tổ hợp như sau:

Ví dụ LÒ 1 có 3 KHUÔN (2,4,6) thì tương ứng với 3 giá trị x, y, z sẽ lọc ra được 3 giá trị theo quy tắc LÒ/GIÁ TRỊ/KHUÔN ( 1/x/2 - 1/y/4 - 1/z/6). Làm tiếp tục với LÒ 2 và n LÒ.

Em cảm ơn và chúc sức khỏe cả nhà.

 

[snow25]

Xin chào ACE GiaiPhapExcel,

Nhờ AC giúp em tạo tổ hợp có miêu tả như trong file đính kèm.

Em có 1 cột dọc là số LÒ, 1 cột ngang là số KHUÔN, tương ứng với số lò và khuôn là 1 giá trị. Nhờ anh chị viết dùm đoạn code để lấy ra tổ hợp như sau:

Ví dụ LÒ 1 có 3 KHUÔN (2,4,6) thì tương ứng với 3 giá trị x, y, z sẽ lọc ra được 3 giá trị theo quy tắc LÒ/GIÁ TRỊ/KHUÔN ( 1/x/2 - 1/y/4 - 1/z/6). Làm tiếp tục với LÒ 2 và n LÒ.

Em cảm ơn và chúc sức khỏe cả nhà.

Bạn chạy thử cái sub này nhé.

Sub linhtinh()
    Dim arr, arr1, i As Long, j As Long, a As Long, lr As Long
    With Sheets("sheet1")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         arr = .Range("B2:E" & lr).Value
         ReDim arr1(1 To UBound(arr, 1) * UBound(arr, 2), 1 To 1)
         For i = 2 To UBound(arr, 1)
             For j = 2 To UBound(arr, 2)
                 a = a + 1
                arr1(a, 1) = arr(i, 1) & "/" & arr(i, j) & "/" & arr(1, j)
             Next j
        Next i
        lr = .Range("I" & Rows.Count).End(xlUp).Row
        If lr > 2 Then .Range("I3:I" & lr).ClearContents
        If a Then .Range("I3").Resize(a).Value = arr1
    End With
End Sub

 

[peternhp29]

Bạn chạy thử cái sub này nhé.

Sub linhtinh()
    Dim arr, arr1, i As Long, j As Long, a As Long, lr As Long
    With Sheets("sheet1")
         lr = .Range("B" & Rows.Count).End(xlUp).Row
         arr = .Range("B2:E" & lr).Value
         ReDim arr1(1 To UBound(arr, 1) * UBound(arr, 2), 1 To 1)
         For i = 2 To UBound(arr, 1)
             For j = 2 To UBound(arr, 2)
                 a = a + 1
                arr1(a, 1) = arr(i, 1) & "/" & arr(i, j) & "/" & arr(1, j)
             Next j
        Next i
        lr = .Range("I" & Rows.Count).End(xlUp).Row
        If lr > 2 Then .Range("I3:I" & lr).ClearContents
        If a Then .Range("I3").Resize(a).Value = arr1
    End With
End Sub

Cảm ơn bạn rất nhiều, chạy rất đúng ý của mình. Mình sẽ nghiên cứu để cải tiến thêm cho công việc.

Chúc sức khỏe bạn nhé.