chuyển list hãng tàu sang mẫu làm việc

[buisytrung]

Em có list container của hãng tàu muốn lọc một số thông tin cơ bản chuyển vào mẫu sẵn
cụ thể:
-Dựa vào cột cell(6 chữ số) lọc dữ liệu có 2 chữ số đầu chạy từ 1-99 để xác định số Bay và thỏa mãn chữ số thứ 5 nếu là 8 thì tiêu đề ghi on deck discharging, copy vào một mẫu hoặc là 0 thì hold discharging copy vào mẫu kế tiếp. Mỗi mẫu giới hạn 15 container
- Em mới làm được từng trường hợp lọc cụ thể, còn triển khai một lúc từ 1-99 còn bí. Mong các bác ra tay giúp đỡ, chỉnh sửa và bổ sung code dưới giúp em

 

[Hoàng Trọng Nghĩa]

Em có list container của hãng tàu muốn lọc một số thông tin cơ bản chuyển vào mẫu sẵn
cụ thể:
-Dựa vào cột cell(6 chữ số) lọc dữ liệu có 2 chữ số đầu chạy từ 1-99 để xác định số Bay và thỏa mãn chữ số thứ 5 nếu là 8 thì tiêu đề ghi on deck discharging, copy vào một mẫu hoặc là 0 thì hold discharging copy vào mẫu kế tiếp. Mỗi mẫu giới hạn 15 container
- Em mới làm được từng trường hợp lọc cụ thể, còn triển khai một lúc từ 1-99 còn bí. Mong các bác ra tay giúp đỡ, chỉnh sửa và bổ sung code dưới giúp em

bạn có thể nói rõ hơn được không? tại sheet nào, cột nào, hàng nào, chuyển từ đâu, điều kiện là gì được không?

 

[SA_DQ]

Macro của bạn đây, xin mời xem thêm trong file kèm theo

Hãy làm theo Comment tại 'L3' hay 'L33' của 'KetQua'

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 
 If Not Intersect(Target, Union([l3], [L33])) Is Nothing Then
   Dim Sh As Worksheet, Sht As Worksheet:                Dim Rng As Range
   Dim eRw As Long, Jj As Long:                         Dim Cot5 As Byte
   
   Set Sh = Sheets("DuLieu"):                           Set Sht = Sheets("TrG")
   eRw = Sh.[c65500].End(xlUp).Row:                 Sht.[B4].Resize(eRw, 11).ClearContents
   Application.ScreenUpdating = False
   If Target.Row > 9 Then Cot5 = 8
   For Jj = 4 To eRw
      With Sh.Cells(Jj, "C")
         If (.Value \ 10) Mod 10 = Cot5 And .Value / 10 ^ 4 >= 1 Then
            Sht.[b65500].End(xlUp).Offset(1).Resize(, 11).Value =  _
                .Offset(, -1).Resize(, 11).Value
         End If
      End With
   Next Jj
   Set Sh = Nothing:                                     Cot5 = Target.Value
   Set Rng = Switch(Target.Row > 9, [C37], Target.Row < 9, [c7])
   Rng.Resize(15, 3).Value = Sht.Cells(4 + 15 * (Cot5 - 1), "C").Resize(15, 3).Value
 End If
End Sub

 

[buisytrung]

to minhthien321
to SA_DQ
2 bác hiểu hơi sai ý em một chút
em lấy ví dụ cụ thể với 4 container
010182
030104
030108
030184
2 số đầu 01,03 tương ứng với bay 01, 03
số thứ 5: 8 tương ứng với on deck discharging,0 tương ứng với hold discharging
bay 01 chỉ có một cont vẫn copy vào một mẫu
bay 03 gồm 2 mẫu riêng
+ ondeck: 030184
+ hold: 030108
copy nội dung cột cell, cntrno, SzTp, Wgt, F/E, Remarks sang cột tương ứng stowage postion, container no, Sz/Tp, Wgt, F/E, Out of Gauge
Xác định lần lượt từ bay 01 cho tới bay 99
Tất cả cho vào một sheet để nhấn một nút in ra luôn
Mọi người cứ nhiệt tình giúp em đừng ngại nhé

From Sa_DQ
Đọc bài viết nữa tiếng Việt nữa tiếng tây, là người ngoại đạo, giống như trời tối đi trên đường sống trâu vậy; Có tí rượu nữa thì hay lắm đây. . .

 

[buisytrung]

bác Sa_DQ ơi bác dòm qua cái code của em đi, nó hơi gà nhưng nó thể hiện rõ cách làm, copy cái gì, như thế nào, vào đâu. Em làm ví dụ trường hợp 06(bay 06) rồi đấy bác nhưng để làm với các trường hợp 01,02...99 thì cần đặt vòng lặp thế nào để các mẫu làm việc kế tiếp nhau và nằm trong một sheet tiện cho việc in ra đồng loạt. Em đã bật đèn đường sáng trưng rồi đó, cho dù có tí men nhưng em tin bác về tới nhà nhanh và an toàn thôi
Mọi người biết gì nói lấy, không biết cũng ủng hộ em phát, người nhà giải pháp excel cả mà đừng khách khí

From Sa_DQ:
Nếu 1 BAY nào đó > 15 Records trong một list nào đó thì làm răng chừ?

 

[thanh_tks]

Bài của bạn nếu tạo thêm 1 cột phụ thì rễ làm hơn, bạn đồng ý giải pháp này thì mình thử làm cho bạn tham khảo

 

[SA_DQ]

Thêm một lần nữa sửa theo ý mình hiểu (?!)

Option Explicit
[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
 If Not Intersect(Target, [L3]) Is Nothing Then
   [c7].Resize(15, 10).ClearContents:              [c37].Resize(15, 10).ClearContents
   FilterAndCopy Target.Value
 End If
[B]End Sub[/B]

Sub FilterAndCopy(StrC)
 Dim Sh As Worksheet, Sht As Worksheet, Rng As Range, Clls As Range, eRng As Range
 Dim Min_ As Long, eRw As Long, Max_ As Long:            Dim Num2 As Byte
 
 Set Sh = Sheets("DuLieu"):                              Set Sht = Sheets("TrG")
 eRw = Sh.[c65500].End(xlUp).Row:                        Min_ = StrC * 10 ^ 4
 Set Rng = Sh.Range("c3:C" & eRw):                       Max_ = (StrC + 1) * 10 ^ 4
 Sht.[b4].Resize(Rng.Rows.Count, 11).ClearContents:      Application.ScreenUpdating = False
 
 For Each Clls In Rng
   If Clls.Value >= Min_ And Clls.Value < Max_ Then
      Num2 = (Clls.Value \ 10) Mod 10
      Sht.[b65500].End(xlUp).Offset(1).Resize(, 11).Value =  _
             Clls.Offset(, -1).Resize(, 11).Value
      Set eRng = IIf(Num2 = 8, [C52], [c22])
      eRng.End(xlUp).Offset(1).Resize(, 7).Value = Clls.Resize(, 7).Value
   End If
 Next Clls
 Set Sh = Nothing
End Sub

& Macro tại "DuLieu" để tạo danh sách duy nhất cho ô làm việc 'L3' tại 'KetQua'

Mình chưa rõ trường hợp vượt 15 Records thì sao đây?

 

[buisytrung]

To Sa_DQ
Bác cho em code rất hay:ngắn gọn, tốc độ nhanh, lọc theo tiêu chuẩn rất nhanh
Tuy nhiên, Bác giúp em phát nữa đi cho phù hợp hơn
+ Dữ liệu ban đầu chưa biết rõ giới hạn, 169 container(dữ liệu mẫu) hoặc có thể lớn hơn, nhỏ hơn
+ Số mẫu(working sequence sheet) cũng không giới hạn(không nhất thiết chỉ 2 mẫu) phụ thuộc vào tiêu chuẩn lọc và số container.

From Sa_DQ:
Nếu 1 BAY nào đó > 15 Records trong một list nào đó thì làm răng chừ?

trường hợp này dù dư 1 thì cho vào mẫu kế tiếp. Vd: dư 16 ... thì thêm 2 mẫu kế tiếp cùng loại
Bác lọc được cho em từng bay rồi nhưng có cách nào
+ Từ Bay lọc ra xác định giá trị cho ô BAY, tiêu đề cho mẫu đó là hold discharging hay on deck discharging
+ Từ Số mẫu (working sequence sheet) xác định giá trị: Sheet No, Sheet total
+ Hiển thị cùng lúc tất cả kết quả trên 1 sheet để tiện in ra hết không cần phải chọn từng bay như chọn ở L3 của bác
ví dụ 17 container
100608,100108,100204,100206,100208,100304,100306,100308,100404,100406,100408,100504,100506,100508,100604,100606
100688
ta có 3 mẫu
+ Mẫu 1:gồm15 container
100608,100108,100204,100206,100208,100304,100306,100308,100404,100406,100408,100504,100506,100508,100604 (bay 10, tiêu đề mẫu "hold discharging", sheet no 1, sheet total 2)
+ Mẫu 2: gồm 1 container
100606
(bay 10, tiêu đề mẫu "hold discharging", sheet no 2, sheet total 2)
+ Mẫu 3: gồm 1 container
100688
(bay 10, tiêu đề mẫu "ondeck discharging", sheet no 1, sheet total 1)
=> Các mẫu này kế tiếp nhau trong một sheet (kết quả)
tương tự các bay khác, kết quả cũng kế tiếp các mẫu này trên cùng một sheet

Bài của bạn nếu tạo thêm 1 cột phụ thì rễ làm hơn, bạn đồng ý giải pháp này thì mình thử làm cho bạn tham khảo

to thanh_tks
Nếu làm được thì quá tốt còn gì, code của tớ thêm (2 cột phụ, 2 sheet trung gian liền mà chưa tới đâu---gà mà thông cảm nhé)
code của bác Sa_DQ còn mất 1 sheet trung gian nữa
Thêm 1 cột phụ đáng gì, cho mình và mọi người tham khảo đi

 

[thanh_tks]

to thanh_tks
Nếu làm được thì quá tốt còn gì, code của tớ thêm (2 cột phụ, 2 sheet trung gian liền mà chưa tới đâu---gà mà thông cảm nhé)
code của bác Sa_DQ còn mất 1 sheet trung gian nữa
Thêm 1 cột phụ đáng gì, cho mình và mọi người tham khảo đi[/QUOTE]

bạn xem có được không nhá! mình làm ở sheet form

 

[SA_DQ]

Tuy nhiên, Bác giúp em phát nữa đi cho phù hợp hơn

+ Dữ liệu ban đầu chưa biết rõ giới hạn, 169 container(dữ liệu mẫu) hoặc có thể lớn hơn, nhỏ hơn
+ Số mẫu(working sequence sheet) cũng không giới hạn(không nhất thiết chỉ 2 mẫu) phụ thuộc vào tiêu chuẩn lọc và số container.
trường hợp này dù dư 1 thì cho vào mẫu kế tiếp. Vd: dư 16 ... thì thêm 2 mẫu kế tiếp cùng loại

(1?) Vậy mỗi loại form chỉ 15 mã container. Có khi nào số container >30 ở loại này hay loại kia hay không?

(2?) Thêm 1 câu hỏi nữa:
Khi chỉ có dữ liệu thuộc loại on deck discharginghay Hold discharging thì ta có thể không cho xuất hiện form thứ hai không có dữ liệu được không?

code của bác Sa_DQ còn mất 1 sheet trung gian nữa
Thêm 1 cột phụ đáng gì, cho mình và mọi người tham khảo đi

Mình tưởng bạn cần Sheet "Trung Gian" Nếu bạn không cần, chúng ta có cách để bỏ nó luôn.

(Thật tình đến giờ mình chưa dám chắc đã hiểu hết ý của bạn!)
Mọi chuyện sẽ rất ư dễ dàng nếu chúng ta hiểu nhau; & Hãy đợi đấy!

 

[thanh_tks]

Ái cha cha !!!! 99 bay ít nhất phải có 200 bảng quả này bác Sa_DQ phải dày công đây
bài bên dưới của Thắng thật hay !

 

[huuthang_bd]

Thử với file này xem sao.

 

[SA_DQ]

Mỗi lần 1 BAY thôi, nha!

Option Explicit
[B]Private Sub Worksheet_Change(ByVal Target As Range)[/B]
 If Not Intersect(Target, [L3]) Is Nothing Then
   FindAndCopy
 End If
[B]End Sub[/B]

Sub FindAndCopy()
 Dim Sh As Worksheet, Sht As Worksheet, Rng As Range, sRng As Range, dRng As Range
 Dim MyAdd As String, eRw As Long:
 Dim Num2 As Byte, sNum As Byte, Num1 As Byte
 
 Set Sh = Sheets("DuLieu")
 eRw = Sh.[c65500].End(xlUp).Row:                     Set Rng = Sh.Range("c3:C" & eRw)
 [M2].Resize(Rng.Rows.Count, 23).ClearContents
 
 sNum = [L3].Value:                                Application.ScreenUpdating = False
 Set sRng = Rng.Find(sNum, , xlFormulas, xlPart)
 If Not sRng Is Nothing Then
   MyAdd = sRng.Address
   Do
      Num2 = (sRng.Value \ 10) Mod 10
      Set dRng = Cells(eRw, IIf(Num2 = 8, "X", "M"))
      If sRng.Value \ 10 ^ 4 = sNum Then _
         dRng.End(xlUp).Offset(1).Resize(, 11).Value = sRng.Resize(, 11).Value
      Set sRng = Rng.FindNext(sRng)
   Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
 End If
 [E4].Value = Sh.[d2].Value:                          [B4].Value = Sh.[a2].Value
'           *           *           *           *           *     '
 Set Sh = Sheets("KetQua")
 Sh.[A1].Resize(eRw, 11).Clear
 eRw = [X65500].End(xlUp).Row:                        Num2 = 0
 If eRw > 1 Then
   Num2 = eRw \ 15 + IIf(eRw \ 15 < eRw / 15, 1, 0)
 End If
 eRw = [M65500].End(xlUp).Row:
 If eRw > 1 Then
   Num1 = eRw \ 15 + IIf(eRw \ 15 < eRw / 15, 1, 0)
 End If
 [K2] = Num1 + Num2
 Set Rng = Range("A1:K29"):                           [c5].Value = sNum
 For sNum = 1 To Num1 + Num2
   Set sRng = Sh.Cells(30 * sNum - 29, "A")
   If sNum <= Num1 Then
      [d5].Value = [B32].Value:                       [K1].Value = sNum
      [C7].Resize(15, 9).Value = Cells(2 + 15 * (sNum - 1), "M").Resize(15, 9).Value
   Else
      [d5].Value = [b33].Value:                       [K1].Value = sNum - Num1
      [C7].Resize(15, 9).Value = Cells(2 + 15 * (sNum - Num1 - 1), "X").Resize(15, 9).Value
   End If

   Rng.Copy Destination:=sRng
   Sh.Select
 Next sNum
End Sub

 

[buisytrung]

Xin chân thành gửi lời cảm ơn đến bác SA_DQ, bạn huuthang_bd, và bạn thanh_tks
Nhờ sự giúp đỡ nhiệt tình của mọi người vấn đề đã được giải quyết