Bài toán pha phôi chọn thép phù hợp, mọi người giúp đỡ (3 người xem)

[minhnc]

Tôi có 1 bải toán" pha phôi". yêu cầu bài toán trong file đính kèm, mong mọi người giúp đỡ

 

[Tuấn Giang]

Không hiểu ý của bạn là gì cả.

Mà bạn cũng tài thật đấy, bạn gõ dữ liệu dạng text mà sao lại cộng được thế? Có thể chỉ cho tôi không?

Cảm ơn nhiều!

 

[minhnc]

Trong file đính kèm mình chú giải tương đối kỹ. Mọi người xem lại cho

 

[anhtuan1066]

Bải toán này ko hẳn là khó. Cái khó là chưa hiễu rõ ý bạn lắm. Bạn cần tìm "2 cặp" nghĩa là 4 cái à? Tôi thấy bài bạn làm, bạn đã chia sẳn nhóm ở Sheet KQ, có nhóm thì có 1 cái, có nhóm lại có 2 cái. Và Subtotal ở dưới có cái là tổng của 2 cái, có cái lại là tổng của 3 cái. Thế là thế nào nhỉ? Bạn có thể nói rõ hơn dc ko?
Còn tôi thì đang hiểu rằng bạn muốn tìm 2 cây sắt sao cho tổng chiều dài của 2 cây đó ko lớn hơn 6m, và tổng đó là lớn nhất trong tất cả các tổng tìm dc nhỏ hơn 6m. Có đúng thế ko hay là như thế nào?
ANH TUẤN

 

[SA_DQ]

Bạn tham khảo macro sau:

Option Explicit[b]
Sub Para6() [/b]
 Dim iJ As Long, iZ As Long
 Dim KTh1 As Double, KTh2 As Double
 Dim Rng1 As Range, Rng2 As Range, UniRng As Range, tRng As Range
 
 Sheets("DuLieu").Select
 Range("B300").Value = "''":         Set tRng = Range("B300:E300")
 For iJ = 2 To 20
    KTh1 = Range("B" & iJ).Offset(0, 2).Value
    Set Rng1 = Range("B" & iJ & ":E" & iJ)
    For iZ = (iJ + 1) To 21
        KTh2 = Range("B" & iZ).Offset(0, 2).Value
        If KTh1 + KTh2 <= 6 Then
            Set Rng2 = Range("B" & iZ & ":E" & iZ)      
[COLOR="Blue"]'Bổ sung:  [/COLOR]
            Range("E300").Value = KTh1 + KTh2       
            If UniRng Is Nothing Then
                Set UniRng = Union(Rng1, Rng2, tRng)
            Else
                Set UniRng = Union(UniRng, Rng1, Rng2, tRng)
            End If
            UniRng.Copy Destination:=Worksheets("KQ").Range("b55554").End(xlUp).Offset(1, 0)
        End If
        Set UniRng = Nothing
 Next iZ, iJ
    Set Rng1 = Nothing:                 Set Rng2 = Nothing
    tRng.ClearContents:                 Set tRng = Nothing
[b]End Sub[/b]

 

[minhnc]

Thannk bạn nhiều, nhưng vấn đề như anhtuan nói. Tìm 2 cây sắt có độ dài <=6m và 2 cây đó có độ dài là lớn nhất làm 1 cặp. Nếu 2 cây đó đã được chọn thì ko được chọn ở cặp khác nữa.Tôi thấy đoạn code của SA_DQ trên tức là tìm 1 thanh sau đó ghép với nhiều thanh khác thoả mãn ĐK bài toán nhưng vấn đề fải tối ưu lại như trên(VD PL1 ghép được PL5 thì PL1, PL5 ko được ghép bất cứ thanh nào nữa). Mog mọi người ra tay giúp đỡ

 

[SA_DQ]

/)/ó đây nè!

Option Explicit:            Option Base 1 [b]
Sub ParaMax()[/b]
 ReDim MgRng(6):            ReDim Chon(29) As Boolean
 Dim iJ As Long, iZ As Long, iDem As Byte
 Dim Rng1, Rng2, KTh1 As Double, KTh2 As Double, KTh As Double, KThTemp As Double
 
 Sheets("DuLieu").Select
 For iJ = 2 To 20
    KTh1 = Range("B" & iJ).Offset(0, 2).Value
    Rng1 = Range("B" & iJ).Value
    For iZ = (iJ + 1) To 21
        KTh2 = Range("B" & iZ).Offset(0, 2).Value
        KTh = KTh1 + KTh2
        If KTh >= KThTemp And Chon(iJ) = False And Chon(iZ) = False And KTh <= 6 Then
                Chon(iJ) = True:              Chon(iZ) = True
                KThTemp = KTh
                Rng2 = Range("B" & iZ).Value:           iDem = 1 + iDem
                Select Case iDem
                Case 1
                    MgRng(1) = Rng1 & " " & Rng2 & "   " & Str(KTh)
                Case 2
                    MgRng(2) = MgRng(1)
                    MgRng(1) = Rng1 & "  " & Rng2 & "   " & Str(KTh)
                Case 3
                    MgRng(3) = MgRng(2):                MgRng(2) = MgRng(1)
                    MgRng(1) = Rng1 & "  " & Rng2 & "   " & Str(KTh)
                Case 4
                    MgRng(4) = MgRng(3)
                    MgRng(3) = MgRng(2):                MgRng(2) = MgRng(1)
                    MgRng(1) = Rng1 & "  " & Rng2 & "   " & Str(KTh)
                Case 5
                    MgRng(5) = MgRng(4):                MgRng(4) = MgRng(3)
                    MgRng(3) = MgRng(2):                MgRng(2) = MgRng(1)
                    MgRng(1) = Rng1 & "  " & Rng2 & "   " & Str(KTh)
                Case Is > 5
                    MgRng(6) = MgRng(5)
                    MgRng(5) = MgRng(4):                MgRng(4) = MgRng(3)
                    MgRng(3) = MgRng(2):                MgRng(2) = MgRng(1)
                    MgRng(1) = Rng1 & "  " & Rng2 & "   " & Str(KTh)
                End Select
        End If
        
 Next iZ, iJ
 Sheets("KQ").Select:                            Range("B4").Select
 With Selection
    .Value = MgRng(1):                          .Offset(1, 0).Value = MgRng(2)
    .Offset(2, 0).Value = MgRng(3):             .Offset(3, 0).Value = MgRng(4)
    .Offset(4, 0).Value = MgRng(5):             .Offset(5, 0).Value = MgRng(6)
 
 End With
[b]End Sub [/b]

 

[minhnc]

Có lẽ mình truyền đạt làm mọi người ko hiểu hết. Sau khai chạy MCR trên cho kết quả là các cặp sau: (PL 4 PL 5 = 5.95m), cặp 2PL 3 PL 13= 5.7m) cặp 3PL 1 PL 7= 5.7m). OK , vấn đề ko có vấn đề jì, nhưng các cặp khác cảu các PL chưa có trong 3 cặp thì sao???. Tức là tôi đang muốn làm bài toán này để mua vật tư sao cho tối ưu nhất. Theo TKế thì người ta cho các PL trên, nhưng thường thép tiêu chuẩn là mỗi đoạn 6m. Vấn đề là tôi fải chọn 2 thanh làm 1 cặp để ghép sao cho mua được bằng hoặc gần bằng chiều dài thép tiêu chuẩn có trên thị trường.

 

[SA_DQ]

(/ậy thì bạn chạy Mcr (macro) Para6; Sau đó tiến hành Sort theo tổng Kích thước mà Mcr đưa ra & lựa = mắt thường hay = VBA thì tùy thích
Để dễ Sort, bạn nên sửa lại Para6, không nhiều lắm đâu;

(húv &ui &ẽ đón ~ cơn mưa đầu mùa!

 

[minhnc]

VBA mình ko sành lắm nên edit là vấn đề. Còn sửa = mắt thường có lẽ ko khả thi vì VD tôi đưa ra các phẩn tử rất ít so với thực tế, thực tế có hàng ngàn phần tử . SA_DQ xem có cách nào nữa ko?

 

[SA_DQ]

thực tế có hàng ngàn phần tử . SA_DQ xem có cách nào nữa ko?

Mod nào ngang qua đây xóa dùm bài này: Thay = bài # dưới đây:

 

[SA_DQ]

/(/)ình mới nghỉ ra 1 cách; nếu thấy được bạn cho biết!

Các Mod & SMod đi ngang qua đây xóa dùm bài này (Trùng lắp)!
Xin Cảm ơn!

 

[SA_DQ]

/(/)ột cách nữa đây:

Sử dụng 1 combo cùng với các hàm Offset(); AdvancedFilter sau đó Sort lại theo hai hướng ngược nhau;
Hãy xem trong file đính kèm! VD có gần 200 records cho bạn chọn, mệt nghỉ!