Giúp sữa lỗi code (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
P

phongkiemtinh

Thành viên thường trực
Tham gia
22/7/09
Bài viết
224
Được thích
5
E có code sau nhờ thành viên GPE giúp đỡ chút.Code :

Const LIQUID As String = "DOW_FEB_AMB_FBR"
Const LAUNDRY As String = "DYN_FAB_TRO_TID_VN_TH_BNX_ARI"
Const HAIRCARE As String = "H&S_PTN_RJC_REJ_PAN_HS"
Sh.Select: [L1].Value = "Varian"
Set Rng = ThisWorkbook.Worksheets("Note").Range("GName")
For Each Cls In Range([C2], [C2].End(xlDown))
Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
With Cells(Cls.Row, "L")
.Offset(, 1).FormulaR1C1 = "=RC[-7]+RC[-6]"
If Not sRng Is Nothing Then
.Value = "liquid 48h"
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)
Else
If InStr(LIQUID, Left(Cls.Offset(, 2), 3)) Then
.Value = "LIQUID."
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(27, 0, 0) '*'
ElseIf InStr(LAUNDRY, Left(Cls.Offset(, 2), 3)) Then
.Value = "LAUNDRY"
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(11, 0, 0) '*'
ElseIf InStr(HAIRCARE, Left(Cls.Offset(, 2), 3)) Then
.Value = "HAIRCARE"
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)
End If
End If
End With
Next Cls
Set RngHC = ThisWorkbook.Worksheets("Note").Range( "GNameHC")
For Each ClsHC In Range([C2], [C2].End(xlDown))
Set sRngHC = RngHC.Find(ClsHC.Value, , xlFormulas, xlWhole)
With Cells(ClsHC.Row, "L")
.Offset(, 1).FormulaR1C1 = "=RC[-7]+RC[-6]"
If Not sRngHC Is Nothing Then
.Value = "Hairare 48h"
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)

End If
End With
Next ClsHC

[M1].Value = "Date release": [K1].Value = "CotK"
[m2].Resize(Rws).NumberFormat = "dd/mm/yyyy Hh:mm"

E làm mà code chỉ chạy theo dòng màu đỏ, còn code dòng màu xanh không chạy.
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
phongkiemtinh đã viết:
E có code sau nhờ thành viên GPE giúp đỡ chút.Code :

E làm mà code chỉ chạy theo dòng màu đỏ, còn code dòng màu xanh không chạy.
Nhấp chuột vào đây để mở rộng...
Màu xanh thì có đến 2 màu, còn màu đỏ thì chả thấy! Muốn người khác giúp đỡ thì bạn chỉ rõ nguyên nhân nó sai, chạy sai ở chỗ nào, dữ liệu đúng là gì v.v... càng mô tả cụ thể thì dễ dàng giúp bạn hơn.

À, nhìn file của bạn tôi nghĩ ai đó đã giúp cho bạn code này, chắc bạn phải nhờ lại người đó giúp đỡ cho bạn thôi.
 
Upvote 0
Hoàng Trọng Nghĩa đã viết:
Màu xanh thì có đến 2 màu, còn màu đỏ thì chả thấy! Muốn người khác giúp đỡ thì bạn chỉ rõ nguyên nhân nó sai, chạy sai ở chỗ nào, dữ liệu đúng là gì v.v... càng mô tả cụ thể thì dễ dàng giúp bạn hơn.

À, nhìn file của bạn tôi nghĩ ai đó đã giúp cho bạn code này, chắc bạn phải nhờ lại người đó giúp đỡ cho bạn thôi.
Nhấp chuột vào đây để mở rộng...
Đúng là e nhờ Hyen17 giúp, cod egốc ban đầu là thế này:

Option Explicit
Sub gpe()
Const FC As String = "-"
Dim Sh As Worksheet, Rng As Range, Cls As Range, sRng As Range
Dim Rws As Long

11 'Xóa Các Dòng 2,3 & 5 Tai Trang Source:'
Worksheets("Source").Select
Union(Rows("3:3"), Rows("5:5")).Delete
12 'Xóa Các Cot Cuói:'
Columns("K:o").ClearContents
2 'Them Cong Thúc Vo Cot "A":'
[A3].Value = "GPE.com": [k3].Value = "GPE":
Rws = [B3].CurrentRegion.Rows.Count + 2
[A4].FormulaR1C1 = "=RC[2]&""-""&RC[3]&""-""&RC[1]"
Range("A4").Select
Selection.AutoFill Destination:=Range("A4:A" & Rws), Type:=xlFillDefault
3 'Them Cong Thúc Vo Cot "K":'
Range("K4").FormulaR1C1 = "=COUNTIF(R4C[-10]:RC[-10],RC[-10])"
Range("K4").Select
Selection.AutoFill Destination:=Range("K4:K" & Rws), Type:=xlFillDefault
4 'Sáp Xép CSDL:'
Set Rng = [B3].CurrentRegion
Rng.Select
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Key2:=Range("F4") _
, Order2:=xlDescending, Key3:=Range("G4"), Order3:=xlDescending, Header _
:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
', DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
5 'Loc Du Lieu:'
[AA3].Resize(, 12).Value = [A3].Resize(, 12).Value
[Aj1:Ak1].Value = [Aj3:AK3].Value
[aj2].Value = "CS": [AK2].Value = 1
Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("AJ1:AK2"), CopyToRange:=Range("AA3:AK3"), Unique:=False
6 'Xóa Du Lieu Cu:'
Set Sh = ThisWorkbook.Worksheets("LeadTime")
Sh.[b1].CurrentRegion.Offset(1).Clear
7 'Copy Du Lieu Da Loc Sang "LeadTime":'
[AB3].CurrentRegion.Offset(4).Copy Destination:=Sh.[A2]

8 'Nhap Chuoi Tuong Úng Tai Cot "L":'
Const LIQUID As String = "DOW_FEB_AMB_FBR"
Const LAUNDRY As String = "DYN_FAB_TRO_TID_VN_TH_BNX_ARI"
Const HAIRCARE As String = "H&S_PTN_RJC_REJ_PAN_HS"
Sh.Select: [L1].Value = "Varian"
Set Rng = ThisWorkbook.Worksheets("Note").Range("GName")
For Each Cls In Range([C2], [C2].End(xlDown))
Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
With Cells(Cls.Row, "L")
.Offset(, 1).FormulaR1C1 = "=RC[-7]+RC[-6]"
If Not sRng Is Nothing Then
.Value = "LIQUID 48h"
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)
Else
If InStr(LIQUID, Left(Cls.Offset(, 2), 3)) Then
.Value = "LIQUID."
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(27, 0, 0) '*'
ElseIf InStr(LAUNDRY, Left(Cls.Offset(, 2), 3)) Then
.Value = "LAUNDRY"
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(11, 0, 0) '*'
ElseIf InStr(HAIRCARE, Left(Cls.Offset(, 2), 3)) Then
.Value = "HAIRCARE"
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)
End If
End If
End With
Next Cls
[M1].Value = "Date release": [K1].Value = "CotK"
[m2].Resize(Rws).NumberFormat = "dd/mm/yyyy Hh:mm"

Worksheets("Source").Select
Range("2:2,4:4").Select
Selection.Insert Shift:=xlDown
Set Sh = Nothing: Sheets("Report").Select
End Sub



Lúc đó e chỉ có 1 vùng dò đặt tên là "Gname", nếu giá trị nằm trong vùng này thì trả về là .Value = "LIQUID 48h".
Nhưng giờ e muốn thêm 1 vùng dò nữa tên là "GnameHC", va giá trị dò trong vùng này sẽ trả về .Value = "Haircare 48h".
A xem file và sửa dùm e dc không, E chớ mấy ngày không thấy HYen17 lên diễn đàn.
 
Upvote 0
phongkiemtinh đã viết:
Đúng là e nhờ Hyen17 giúp, cod egốc ban đầu là thế này:

A xem file và sửa dùm e dc không, E chớ mấy ngày không thấy HYen17 lên diễn đàn.
Nhấp chuột vào đây để mở rộng...
Nhìn code là tôi biết của người nào rồi, code rất đặc trưng, bạn có thể nhờ bác Sa_DQ hay bác ChanhTQ@ giúp bạn được, vì 2 bác này cũng có thuật toán giống Chị HYen17 đấy!
 
Upvote 0
phongkiemtinh đã viết:
Đúng là e nhờ Hyen17 giúp, cod egốc ban đầu là thế này:

Option Explicit
Sub gpe()
Const FC As String = "-"
Dim Sh As Worksheet, Rng As Range, Cls As Range, sRng As Range
Dim Rws As Long

11 'Xóa Các Dòng 2,3 & 5 Tai Trang Source:'
Worksheets("Source").Select
Union(Rows("3:3"), Rows("5:5")).Delete
12 'Xóa Các Cot Cuói:'
Columns("K:o").ClearContents
2 'Them Cong Thúc Vo Cot "A":'
[A3].Value = "GPE.com": [k3].Value = "GPE":
Rws = [B3].CurrentRegion.Rows.Count + 2
[A4].FormulaR1C1 = "=RC[2]&""-""&RC[3]&""-""&RC[1]"
Range("A4").Select
Selection.AutoFill Destination:=Range("A4:A" & Rws), Type:=xlFillDefault
3 'Them Cong Thúc Vo Cot "K":'
Range("K4").FormulaR1C1 = "=COUNTIF(R4C[-10]:RC[-10],RC[-10])"
Range("K4").Select
Selection.AutoFill Destination:=Range("K4:K" & Rws), Type:=xlFillDefault
4 'Sáp Xép CSDL:'
Set Rng = [B3].CurrentRegion
Rng.Select
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Key2:=Range("F4") _
, Order2:=xlDescending, Key3:=Range("G4"), Order3:=xlDescending, Header _
:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
', DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
5 'Loc Du Lieu:'
[AA3].Resize(, 12).Value = [A3].Resize(, 12).Value
[Aj1:Ak1].Value = [Aj3:AK3].Value
[aj2].Value = "CS": [AK2].Value = 1
Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("AJ1:AK2"), CopyToRange:=Range("AA3:AK3"), Unique:=False
6 'Xóa Du Lieu Cu:'
Set Sh = ThisWorkbook.Worksheets("LeadTime")
Sh.[b1].CurrentRegion.Offset(1).Clear
7 'Copy Du Lieu Da Loc Sang "LeadTime":'
[AB3].CurrentRegion.Offset(4).Copy Destination:=Sh.[A2]

8 'Nhap Chuoi Tuong Úng Tai Cot "L":'
Const LIQUID As String = "DOW_FEB_AMB_FBR"
Const LAUNDRY As String = "DYN_FAB_TRO_TID_VN_TH_BNX_ARI"
Const HAIRCARE As String = "H&S_PTN_RJC_REJ_PAN_HS"
Sh.Select: [L1].Value = "Varian"
Set Rng = ThisWorkbook.Worksheets("Note").Range("GName")
For Each Cls In Range([C2], [C2].End(xlDown))
Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
With Cells(Cls.Row, "L")
.Offset(, 1).FormulaR1C1 = "=RC[-7]+RC[-6]"
If Not sRng Is Nothing Then
.Value = "LIQUID 48h"
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)
Else
If InStr(LIQUID, Left(Cls.Offset(, 2), 3)) Then
.Value = "LIQUID."
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(27, 0, 0) '*'
ElseIf InStr(LAUNDRY, Left(Cls.Offset(, 2), 3)) Then
.Value = "LAUNDRY"
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(11, 0, 0) '*'
ElseIf InStr(HAIRCARE, Left(Cls.Offset(, 2), 3)) Then
.Value = "HAIRCARE"
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)
End If
End If
End With
Next Cls
[M1].Value = "Date release": [K1].Value = "CotK"
[m2].Resize(Rws).NumberFormat = "dd/mm/yyyy Hh:mm"

Worksheets("Source").Select
Range("2:2,4:4").Select
Selection.Insert Shift:=xlDown
Set Sh = Nothing: Sheets("Report").Select
End Sub



Lúc đó e chỉ có 1 vùng dò đặt tên là "Gname", nếu giá trị nằm trong vùng này thì trả về là .Value = "LIQUID 48h".
Nhưng giờ e muốn thêm 1 vùng dò nữa tên là "GnameHC", va giá trị dò trong vùng này sẽ trả về .Value = "Haircare 48h".
A xem file và sửa dùm e dc không, E chớ mấy ngày không thấy HYen17 lên diễn đàn.
Nhấp chuột vào đây để mở rộng...

Sửa từ code gốc này, thay thế toàn bộ bằng sub GPE mới sau đây,

Vì không phải tác giả gốc, nên sửa đại theo ý bạn trình bày, do đó không đảm bảo có chính xác không? bạn tự kiểm tra nhé

chú ý trong code mới sau chỉ thêm các dòng: 0, 81,82,83,84,85,86 --> nhằm đảm bảo code thêm chức năng người hỏi muốn, và thực hiện nhanh chút


PHP: 
Sub gpe()
    Const FC As String = "-"
    Dim Sh As Worksheet, Rng As Range, Cls As Range, sRng As Range
    Dim Rws As Long

0   Application.ScreenUpdating = False

11 'Xóa Các Dòng 2,3 & 5 Tai Trang Source:'
    Worksheets("Source").Select
    Union(Rows("3:3"), Rows("5:5")).Delete
12 'Xóa Các Cot Cuói:'
    Columns("K:o").ClearContents
2 'Them Cong Thúc Vo Cot "A":'
    [A3].Value = "GPE.com": [k3].Value = "GPE":
    Rws = [B3].CurrentRegion.Rows.Count + 2
    [A4].FormulaR1C1 = "=RC[2]&""-""&RC[3]&""-""&RC[1]"
    Range("A4").Select
    Selection.AutoFill Destination:=Range("A4:A" & Rws), Type:=xlFillDefault
3 'Them Cong Thúc Vo Cot "K":'
    Range("K4").FormulaR1C1 = "=COUNTIF(R4C[-10]:RC[-10],RC[-10])"
    Range("K4").Select
    Selection.AutoFill Destination:=Range("K4:K" & Rws), Type:=xlFillDefault
4 'Sáp Xép CSDL:'
    Set Rng = [B3].CurrentRegion
    Rng.Select
    Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Key2:=Range("F4") _
    , Order2:=xlDescending, Key3:=Range("G4"), Order3:=xlDescending, Header _
    :=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
    ', DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
    xlSortNormal
5 'Loc Du Lieu:'
    [AA3].Resize(, 12).Value = [A3].Resize(, 12).Value
    [Aj1:Ak1].Value = [Aj3:AK3].Value
    [aj2].Value = "CS": [AK2].Value = 1
    Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
    ("AJ1:AK2"), CopyToRange:=Range("AA3:AK3"), Unique:=False
6 'Xóa Du Lieu Cu:'
    Set Sh = ThisWorkbook.Worksheets("LeadTime")
    Sh.[b1].CurrentRegion.Offset(1).Clear
7 'Copy Du Lieu Da Loc Sang "LeadTime":'
    [AB3].CurrentRegion.Offset(4).Copy Destination:=Sh.[A2]

8 'Nhap Chuoi Tuong Úng Tai Cot "L":'
    Const LIQUID As String = "DOW_FEB_AMB_FBR"
    Const LAUNDRY As String = "DYN_FAB_TRO_TID_VN_TH_BNX_ARI"
    Const HAIRCARE As String = "H&S_PTN_RJC_REJ_PAN_HS"
    Sh.Select: [L1].Value = "Varian"
    Set Rng = ThisWorkbook.Worksheets("Note").Range("GName")

81  Dim rgHC As Range, SrgHC As Range
82  Set rgHC = ThisWorkbook.Worksheets("Note").Range("GNameHC")

    For Each Cls In Range([C2], [C2].End(xlDown))
        Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)

83      Set SrgHC = rgHC.Find(Cls.Value, , xlFormulas, xlWhole)

        With Cells(Cls.Row, "L")
            .Offset(, 1).FormulaR1C1 = "=RC[-7]+RC[-6]"
            If Not sRng Is Nothing Then
                .Value = "LIQUID 48h"
                .Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)

84          ElseIf Not SrgHC Is Nothing Then
85              .Value = "HAIRCARE 48h"
86              .Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)

            Else
                If InStr(LIQUID, Left(Cls.Offset(, 2), 3)) Then
                    .Value = "LIQUID."
                    .Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(27, 0, 0) '*'
                ElseIf InStr(LAUNDRY, Left(Cls.Offset(, 2), 3)) Then
                    .Value = "LAUNDRY"
                    .Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(11, 0, 0) '*'
                ElseIf InStr(HAIRCARE, Left(Cls.Offset(, 2), 3)) Then
                    .Value = "HAIRCARE"
                    .Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)
                End If
            End If
        End With
    Next Cls
    [M1].Value = "Date release": [K1].Value = "CotK"
    [m2].Resize(Rws).NumberFormat = "dd/mm/yyyy Hh:mm"
    
    Worksheets("Source").Select
    Range("2:2,4:4").Select
    Selection.Insert Shift:=xlDown
    Set Sh = Nothing: Sheets("Report").Select
End Sub
 
Upvote 0
Hoặc Phương án này (cải thiện chút, chỉ kiểm tra vùng GNameHC khi vùng GName không thấy):
(Vẫn chú ý:
Vì không phải tác giả gốc, nên sửa đại theo ý bạn trình bày, do đó không đảm bảo có chính xác không? bạn tự kiểm tra nhé

chú ý trong code mới sau chỉ thêm các dòng: 0, 81,82,83,84,85,86, 87 --> nhằm đảm bảo code thêm chức năng người hỏi muốn, và thực hiện nhanh chút
)


[GPECODE=vb]Sub gpe()
Const FC As String = "-"
Dim Sh As Worksheet, Rng As Range, Cls As Range, sRng As Range
Dim Rws As Long
0 Application.ScreenUpdating = False
11 'Xóa Các Dòng 2,3 & 5 Tai Trang Source:'
Worksheets("Source").Select
Union(Rows("3:3"), Rows("5:5")).Delete
12 'Xóa Các Cot Cuói:'
Columns("K:o").ClearContents
2 'Them Cong Thúc Vo Cot "A":'
[A3].Value = "GPE.com": [k3].Value = "GPE":
Rws = [B3].CurrentRegion.Rows.Count + 2
[A4].FormulaR1C1 = "=RC[2]&""-""&RC[3]&""-""&RC[1]"
Range("A4").Select
Selection.AutoFill Destination:=Range("A4:A" & Rws), Type:=xlFillDefault
3 'Them Cong Thúc Vo Cot "K":'
Range("K4").FormulaR1C1 = "=COUNTIF(R4C[-10]:RC[-10],RC[-10])"
Range("K4").Select
Selection.AutoFill Destination:=Range("K4:K" & Rws), Type:=xlFillDefault
4 'Sáp Xép CSDL:'
Set Rng = [B3].CurrentRegion
Rng.Select
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Key2:=Range("F4") _
, Order2:=xlDescending, Key3:=Range("G4"), Order3:=xlDescending, Header _
:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
', DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
5 'Loc Du Lieu:'
[AA3].Resize(, 12).Value = [A3].Resize(, 12).Value
[Aj1:Ak1].Value = [Aj3:AK3].Value
[aj2].Value = "CS": [AK2].Value = 1
Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("AJ1:AK2"), CopyToRange:=Range("AA3:AK3"), Unique:=False
6 'Xóa Du Lieu Cu:'
Set Sh = ThisWorkbook.Worksheets("LeadTime")
Sh.[b1].CurrentRegion.Offset(1).Clear
7 'Copy Du Lieu Da Loc Sang "LeadTime":'
[AB3].CurrentRegion.Offset(4).Copy Destination:=Sh.[A2]

8 'Nhap Chuoi Tuong Úng Tai Cot "L":'
Const LIQUID As String = "DOW_FEB_AMB_FBR"
Const LAUNDRY As String = "DYN_FAB_TRO_TID_VN_TH_BNX_ARI"
Const HAIRCARE As String = "H&S_PTN_RJC_REJ_PAN_HS"
Sh.Select: [L1].Value = "Varian"
Set Rng = ThisWorkbook.Worksheets("Note").Range("GName")

81 Dim rgHC As Range, SrgHC As Range
82 Set rgHC = ThisWorkbook.Worksheets("Note").Range("GNameHC")

For Each Cls In Range([C2], [C2].End(xlDown))
Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
With Cells(Cls.Row, "L")
.Offset(, 1).FormulaR1C1 = "=RC[-7]+RC[-6]"
If Not sRng Is Nothing Then
.Value = "LIQUID 48h"
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)
Else
83 Set SrgHC = rgHC.Find(Cls.Value, , xlFormulas, xlWhole)
84 If Not SrgHC Is Nothing Then
85 .Value = "HAIRCARE 48h"
86 .Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)
Else
If InStr(LIQUID, Left(Cls.Offset(, 2), 3)) Then
.Value = "LIQUID."
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(27, 0, 0) '*'
ElseIf InStr(LAUNDRY, Left(Cls.Offset(, 2), 3)) Then
.Value = "LAUNDRY"
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(11, 0, 0) '*'
ElseIf InStr(HAIRCARE, Left(Cls.Offset(, 2), 3)) Then
.Value = "HAIRCARE"
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)
End If
87 End If
End If
End With
Next Cls
[M1].Value = "Date release": [K1].Value = "CotK"
[m2].Resize(Rws).NumberFormat = "dd/mm/yyyy Hh:mm"

Worksheets("Source").Select
Range("2:2,4:4").Select
Selection.Insert Shift:=xlDown
Set Sh = Nothing: Sheets("Report").Select
End Sub[/GPECODE]
 
Upvote 0
vodoi2x đã viết:
Sửa từ code gốc này, thay thế toàn bộ bằng sub GPE mới sau đây,

Vì không phải tác giả gốc, nên sửa đại theo ý bạn trình bày, do đó không đảm bảo có chính xác không? bạn tự kiểm tra nhé

chú ý trong code mới sau chỉ thêm các dòng: 0, 81,82,83,84,85,86 --> nhằm đảm bảo code thêm chức năng người hỏi muốn, và thực hiện nhanh chút


PHP: 
Sub gpe()
    Const FC As String = "-"
    Dim Sh As Worksheet, Rng As Range, Cls As Range, sRng As Range
    Dim Rws As Long

0   Application.ScreenUpdating = False

11 'Xóa Các Dòng 2,3 & 5 Tai Trang Source:'
    Worksheets("Source").Select
    Union(Rows("3:3"), Rows("5:5")).Delete
12 'Xóa Các Cot Cuói:'
    Columns("K:o").ClearContents
2 'Them Cong Thúc Vo Cot "A":'
    [A3].Value = "GPE.com": [k3].Value = "GPE":
    Rws = [B3].CurrentRegion.Rows.Count + 2
    [A4].FormulaR1C1 = "=RC[2]&""-""&RC[3]&""-""&RC[1]"
    Range("A4").Select
    Selection.AutoFill Destination:=Range("A4:A" & Rws), Type:=xlFillDefault
3 'Them Cong Thúc Vo Cot "K":'
    Range("K4").FormulaR1C1 = "=COUNTIF(R4C[-10]:RC[-10],RC[-10])"
    Range("K4").Select
    Selection.AutoFill Destination:=Range("K4:K" & Rws), Type:=xlFillDefault
4 'Sáp Xép CSDL:'
    Set Rng = [B3].CurrentRegion
    Rng.Select
    Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Key2:=Range("F4") _
    , Order2:=xlDescending, Key3:=Range("G4"), Order3:=xlDescending, Header _
    :=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
    ', DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
    xlSortNormal
5 'Loc Du Lieu:'
    [AA3].Resize(, 12).Value = [A3].Resize(, 12).Value
    [Aj1:Ak1].Value = [Aj3:AK3].Value
    [aj2].Value = "CS": [AK2].Value = 1
    Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
    ("AJ1:AK2"), CopyToRange:=Range("AA3:AK3"), Unique:=False
6 'Xóa Du Lieu Cu:'
    Set Sh = ThisWorkbook.Worksheets("LeadTime")
    Sh.[b1].CurrentRegion.Offset(1).Clear
7 'Copy Du Lieu Da Loc Sang "LeadTime":'
    [AB3].CurrentRegion.Offset(4).Copy Destination:=Sh.[A2]

8 'Nhap Chuoi Tuong Úng Tai Cot "L":'
    Const LIQUID As String = "DOW_FEB_AMB_FBR"
    Const LAUNDRY As String = "DYN_FAB_TRO_TID_VN_TH_BNX_ARI"
    Const HAIRCARE As String = "H&S_PTN_RJC_REJ_PAN_HS"
    Sh.Select: [L1].Value = "Varian"
    Set Rng = ThisWorkbook.Worksheets("Note").Range("GName")

81  Dim rgHC As Range, SrgHC As Range
82  Set rgHC = ThisWorkbook.Worksheets("Note").Range("GNameHC")

    For Each Cls In Range([C2], [C2].End(xlDown))
        Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)

83      Set SrgHC = rgHC.Find(Cls.Value, , xlFormulas, xlWhole)

        With Cells(Cls.Row, "L")
            .Offset(, 1).FormulaR1C1 = "=RC[-7]+RC[-6]"
            If Not sRng Is Nothing Then
                .Value = "LIQUID 48h"
                .Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)

84          ElseIf Not SrgHC Is Nothing Then
85              .Value = "HAIRCARE 48h"
86              .Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)

            Else
                If InStr(LIQUID, Left(Cls.Offset(, 2), 3)) Then
                    .Value = "LIQUID."
                    .Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(27, 0, 0) '*'
                ElseIf InStr(LAUNDRY, Left(Cls.Offset(, 2), 3)) Then
                    .Value = "LAUNDRY"
                    .Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(11, 0, 0) '*'
                ElseIf InStr(HAIRCARE, Left(Cls.Offset(, 2), 3)) Then
                    .Value = "HAIRCARE"
                    .Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)
                End If
            End If
        End With
    Next Cls
    [M1].Value = "Date release": [K1].Value = "CotK"
    [m2].Resize(Rws).NumberFormat = "dd/mm/yyyy Hh:mm"
    
    Worksheets("Source").Select
    Range("2:2,4:4").Select
    Selection.Insert Shift:=xlDown
    Set Sh = Nothing: Sheets("Report").Select
End Sub
Nhấp chuột vào đây để mở rộng...
code này e chạy thử không đúng bác vodoi2x ạ, 1 số gcas trong danh sách GnameHC vẫn cho ra giá trị "HAIRCARE" là sai, những gcas trong "Gname" thì ra "LIQUID 48H" và trong "GnameHC" cho ra giá trị "Hẩicre 48h".
Để e thử code bác mới gửi thứ 2 sau xem.
 
Upvote 0
vodoi2x đã viết:
Hoặc Phương án này (cải thiện chút, chỉ kiểm tra vùng GNameHC khi vùng GName không thấy):
(Vẫn chú ý:
Vì không phải tác giả gốc, nên sửa đại theo ý bạn trình bày, do đó không đảm bảo có chính xác không? bạn tự kiểm tra nhé

chú ý trong code mới sau chỉ thêm các dòng: 0, 81,82,83,84,85,86, 87 --> nhằm đảm bảo code thêm chức năng người hỏi muốn, và thực hiện nhanh chút
)


[GPECODE=vb]Sub gpe()
Const FC As String = "-"
Dim Sh As Worksheet, Rng As Range, Cls As Range, sRng As Range
Dim Rws As Long
0 Application.ScreenUpdating = False
11 'Xóa Các Dòng 2,3 & 5 Tai Trang Source:'
Worksheets("Source").Select
Union(Rows("3:3"), Rows("5:5")).Delete
12 'Xóa Các Cot Cuói:'
Columns("K:o").ClearContents
2 'Them Cong Thúc Vo Cot "A":'
[A3].Value = "GPE.com": [k3].Value = "GPE":
Rws = [B3].CurrentRegion.Rows.Count + 2
[A4].FormulaR1C1 = "=RC[2]&""-""&RC[3]&""-""&RC[1]"
Range("A4").Select
Selection.AutoFill Destination:=Range("A4:A" & Rws), Type:=xlFillDefault
3 'Them Cong Thúc Vo Cot "K":'
Range("K4").FormulaR1C1 = "=COUNTIF(R4C[-10]:RC[-10],RC[-10])"
Range("K4").Select
Selection.AutoFill Destination:=Range("K4:K" & Rws), Type:=xlFillDefault
4 'Sáp Xép CSDL:'
Set Rng = [B3].CurrentRegion
Rng.Select
Selection.Sort Key1:=Range("A4"), Order1:=xlAscending, Key2:=Range("F4") _
, Order2:=xlDescending, Key3:=Range("G4"), Order3:=xlDescending, Header _
:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom _
', DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:= _
xlSortNormal
5 'Loc Du Lieu:'
[AA3].Resize(, 12).Value = [A3].Resize(, 12).Value
[Aj1:Ak1].Value = [Aj3:AK3].Value
[aj2].Value = "CS": [AK2].Value = 1
Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range _
("AJ1:AK2"), CopyToRange:=Range("AA3:AK3"), Unique:=False
6 'Xóa Du Lieu Cu:'
Set Sh = ThisWorkbook.Worksheets("LeadTime")
Sh.[b1].CurrentRegion.Offset(1).Clear
7 'Copy Du Lieu Da Loc Sang "LeadTime":'
[AB3].CurrentRegion.Offset(4).Copy Destination:=Sh.[A2]

8 'Nhap Chuoi Tuong Úng Tai Cot "L":'
Const LIQUID As String = "DOW_FEB_AMB_FBR"
Const LAUNDRY As String = "DYN_FAB_TRO_TID_VN_TH_BNX_ARI"
Const HAIRCARE As String = "H&S_PTN_RJC_REJ_PAN_HS"
Sh.Select: [L1].Value = "Varian"
Set Rng = ThisWorkbook.Worksheets("Note").Range("GName")

81 Dim rgHC As Range, SrgHC As Range
82 Set rgHC = ThisWorkbook.Worksheets("Note").Range("GNameHC")

For Each Cls In Range([C2], [C2].End(xlDown))
Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlWhole)
With Cells(Cls.Row, "L")
.Offset(, 1).FormulaR1C1 = "=RC[-7]+RC[-6]"
If Not sRng Is Nothing Then
.Value = "LIQUID 48h"
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)
Else
83 Set SrgHC = rgHC.Find(Cls.Value, , xlFormulas, xlWhole)
84 If Not SrgHC Is Nothing Then
85 .Value = "HAIRCARE 48h"
86 .Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)
Else
If InStr(LIQUID, Left(Cls.Offset(, 2), 3)) Then
.Value = "LIQUID."
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(27, 0, 0) '*'
ElseIf InStr(LAUNDRY, Left(Cls.Offset(, 2), 3)) Then
.Value = "LAUNDRY"
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(11, 0, 0) '*'
ElseIf InStr(HAIRCARE, Left(Cls.Offset(, 2), 3)) Then
.Value = "HAIRCARE"
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)
End If
87 End If
End If
End With
Next Cls
[M1].Value = "Date release": [K1].Value = "CotK"
[m2].Resize(Rws).NumberFormat = "dd/mm/yyyy Hh:mm"

Worksheets("Source").Select
Range("2:2,4:4").Select
Selection.Insert Shift:=xlDown
Set Sh = Nothing: Sheets("Report").Select
End Sub[/GPECODE]
Nhấp chuột vào đây để mở rộng...
Code này cũng giống code trên e kiểm tra thấy không đúng, e upload lên file e chạy.E đã cho data vào sheet "sỏuce", bác tải về chỉ cần nhấp "Run leadtime" chạy, rồi vào sheet "report" kiểm tra cái gcas e ghi lại ở cell comment, nếu sort "HAIRCARE" mà thấy nó là không đúng.
 

File đính kèm

Upvote 0
phongkiemtinh đã viết:
code này e chạy thử không đúng bác vodoi2x ạ, 1 số gcas trong danh sách GnameHC vẫn cho ra giá trị "HAIRCARE" là sai, những gcas trong "Gname" thì ra "LIQUID 48H" và trong "GnameHC" cho ra giá trị "Hẩicre 48h".
Để e thử code bác mới gửi thứ 2 sau xem.
Nhấp chuột vào đây để mở rộng...

sai thì sai ở dòng nào, cụ thể,
nói chung chung thê mình bạn hiểu thui,
vậy thử code 2 xem sao
 
Upvote 0
phongkiemtinh đã viết:
Code này cũng giống code trên e kiểm tra thấy không đúng, e upload lên file e chạy.E đã cho data vào sheet "sỏuce", bác tải về chỉ cần nhấp "Run leadtime" chạy, rồi vào sheet "report" kiểm tra cái gcas e ghi lại ở cell comment, nếu sort "HAIRCARE" mà thấy nó là không đúng.
Nhấp chuột vào đây để mở rộng...

Tôi đã tải về, chạy thử
Thấy tại sheet Leadtime, ở cells
C84: 82197527
L84: HAIRCARE 48h <--- chuẩn

vậy sai ở đâu nhỉ???, bên sub này thì không rõ sheet report ảnh hưởng gì???
 
Upvote 0
Bạn Unhide cột ẩn L ở sheet REPORT

chọn Haircare như bạn mong muốn sẽ thấy có gồm nhiều HAIRCARE 48h --> phải xemlại sự lựa chọn lọc ở đây nhé và SAI là sai ở việc lọc ở đây

hãy kiểm tra cẩn thận,
còn code GPE() chưa chắc đã sai

Đúng vậy

Bạn nên chọn đi chọn lại Filter đó đến khi xuất hiện HAIRCARE 48h thì là lúc này sẽ có report đúng
 
Lần chỉnh sửa cuối:
Upvote 0
vodoi2x đã viết:
Bạn Unhide cột ẩn L ở sheet REPORT

chọn Haircare như bạn mong muốn sẽ thấy có gồm nhiều HAIRCARE 48h --> phải xemlại sự lựa chọn lọc ở đây nhé và SAI là sai ở việc lọc ở đây

hãy kiểm tra cẩn thận,
còn code GPE() chưa chắc đã sai

Đúng vậy

Bạn nên chọn đi chọn lại Filter đó đến khi xuất hiện HAIRCARE 48h thì là lúc này sẽ có report đúng
Nhấp chuột vào đây để mở rộng...
AH, cảm ơn bác nhiều, để e xem chỉnh lại code lọc.Mà code bác thấy chạy nhanh hơn code cũ nữa.
 
Upvote 0
Như nói trên,

* bạn cũng nên kiểm tra lại thủ tục sort trong Worksheet_selectionChange(...)

* và có thể bạn xem code ở dòng ký hiêu 86 của sub GPE CÓ HỢP LÝ KHÔNG??? - vì dòng này tôi không bit thế nào là đúng, -- bạn tự xem nhé -- đặc biệt số 51 (?)

PHP: 
86                  .Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)
 
Lần chỉnh sửa cuối:
Upvote 0
vodoi2x đã viết:
Như nói trên,

* bạn cũng nên kiểm tra lại thủ tục sort trong Worksheet_selectionChange(...)

* và có thể bạn xem code ở dòng ký hiêu 86 của sub GPE CÓ HỢP LÝ KHÔNG??? - vì dòng này tôi không bit thế nào là đúng, -- bạn tự xem nhé -- đặc biệt số 51 (?)

PHP: 
86                  .Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)
Nhấp chuột vào đây để mở rộng...
- Đúng rồi bác, e cảm ơn bác nhiều.
- Số 51 là em công thêm 51 giờ so với giờ mình ngày giờ có được ở cột [F] và [G]. để cho ra giờ cuối cùng mình phải thực hiện.
- E cũng sửa lại sort trong Worksheet_selectionChange(...) rồi, sửa thành:
If Target.Row <> 4 Then Exit Sub
Rows("5:65536").Sort Key1:=Cells(5, Target.Column), Order1:=xlAscending, Header:=xlNo
khi đó chi cần bấm vào tiêu đề.
-E nhầm chưa sửa chỗ này:
 .Value = "HAIRCARE"
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(51, 0, 0)
thành:
.Value = "HAIRCARE"
.Offset(, 1).Value = .Offset(, 1).Value + TimeSerial(27, 0, 0)
.

 
Lần chỉnh sửa cuối:
Upvote 0
Còde số 1 bac vodoi2x thì ok, code thứ 2 gửi lên sau chạy lỗi, có 1 số của haircare 4h chạy qua haircare.hôm nay chạy thực tế mới thấy rõ
 
Upvote 0
phongkiemtinh đã viết:
Còde số 1 bac vodoi2x thì ok, code thứ 2 gửi lên sau chạy lỗi, có 1 số của haircare 4h chạy qua haircare.hôm nay chạy thực tế mới thấy rõ
Nhấp chuột vào đây để mở rộng...

Vì sửa code người khác, và không biết bài gốc thế nào,

Chính vì thế mới nói bạn phải test cẩn thận,

Cái nào đúng thì dùng, nhờ test kỹ

Song code 2, tôi thấy vẫn đúng đó chứ, hay ý bạn khác thế nào tôi không hiểu, bạn cứ kiểm tra lại kỹ đi xem sai do đâu
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

hongphuong1997
Nên sử dụng Chatgpt hay Copilot
    • Yêu thích
Trả lời
5
Đọc
148
SA_DQ
SA_DQ
L
Xin file lịch báo giảng tự động
Trả lời
2
Đọc
67
linedraw84
L
H
Xin File Theo dõi công nợ
Trả lời
0
Đọc
41
HangktGTN
H
2
  • Question Question
Hỏi cách in phiếu điều tra PCGD-XMC từ file dữ liệu mẫu xuất ra từ hệ thống PCGD-XMC của Bộ GD
    • Thích
Trả lời
16
Đọc
990
linedraw84
L
N
Tạo file Excel dùng VBA để lấy và nối dữ liệu từ các files excel (1 người xem)
Trả lời
39
Đọc
6K
hungnv_thct2026
H
S
Power BI. Một quá trình đòi hỏi sự kiên nhẫn. (1 người xem)
Trả lời
4
Đọc
188
SteveNguyen1991
S
SA_DQ
  • Question Question
Bài tập VBA cho những người rỗi. . . đủ thứ!
    • Ngạc nhiên
    • Cười
    • Yêu thích
Trả lời
21
Đọc
726
Phuocam
Phuocam
H
Giúp mình ghép nhiều file thành một file.
Trả lời
9
Đọc
338
Hoàng Tuấn 868
H
H
  • Question Question
Dò tìm giá trị từ bảng khác theo cột
Trả lời
5
Đọc
106
ptm0412
ptm0412
L
Cách bật/tắt đèn led thứ 3 trên bàn phím cơ
Trả lời
1
Đọc
66
HUONGHCKT
H
C
Không thể group cột trong excel
Trả lời
10
Đọc
12K
ptm0412
ptm0412
A
  • Question Question
Em nhờ anh/chị/em/chú/bác giúp em viết code tổng hợp dữ liệu. em tính công thức nó nặng quá. em cám ơn
Trả lời
14
Đọc
990
Hoàng Tuấn 868
H
H
Xin giúp đỡ về phổ cập
Trả lời
5
Đọc
998
tranvanky8111967
T
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
3 4 5
Trả lời
420
Đọc
52K
maingoctu89
M
P
Xin giúp sửa code VBA tổng hợp sản lượng theo format file FCS đổ từ hệ thống ERP.
Trả lời
14
Đọc
310
DeTong
D
L
Nhờ anh chị giúp đỡ công thức hàm len
Trả lời
44
Đọc
764
khuong182018
khuong182018
hongphuong1997
Cách tô màu một dòng theo chiều cao tùy ý
Trả lời
5
Đọc
207
hongphuong1997
hongphuong1997
D
nhờ anh chị giải thích hàm hstack
Trả lời
2
Đọc
153
dungpham01
D
L
Nhờ anh chị giúp giúp đỡ hàm ạ (2 người xem)
    • Chấp nhận
Trả lời
12
Đọc
381
Phan Thế Hiệp
Phan Thế Hiệp
vuthaiha90
Lọc dữ liệu không trùng và trả kết quả về 1 dòng (1 người xem)
Trả lời
6
Đọc
207
Duy Tùng 9x
Duy Tùng 9x
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom