Nhờ các anh giải thích giúp đoạn code lọc theo ngày này với (1 người xem)

[tranvyvn]

em muốn nhờ các cao thủ giải thích chi tiết để em học hỏi
Em cảm ơn mọi người.

Option Explicit
Dim Rng As Range, Sh As Worksheet
Private Sub Worksheet_Change(ByVal Target As Range)
Dim J As Byte, Rws As Long
Dim cRg As Range
Dim MyAdd As String

If Not Intersect(Target, [B1]) Is Nothing Then
Rws = [B3].CurrentRegion.Rows.Count
[A3].Resize(Rws + 9, 17).ClearContents
For J = 1 To 2
Set Sh = ThisWorkbook.Worksheets("DL" & CStr(J))
Set Rng = Sh.[B2].CurrentRegion
MyAdd = Choose(J, "$AC$1:$AO$1", "$AC1:$Ae$1")
Set cRg = Sh.Range(MyAdd)
GPE cRg
If J = 1 Then
Rws = Sh.[AC2].CurrentRegion.Rows.Count
Sh.[AC2].Resize(Rws, 4).Copy Destination:=[A3]
Sh.[AF2].Resize(Rws, 2).Copy Destination:=[F3]
Sh.[AI2].Resize(Rws, 6).Copy Destination:=[j3]
Sh.[ao2].Resize(Rws).Copy Destination:=[q3]
ElseIf J = 2 Then
Range("H3").FormulaR1C1 = "=VLOOKUP(RC[-4],'DL2'!R[-2]C[22]:R[" & Rws & "]C[23],2,FALSE)"
Range("H3").Select
Selection.AutoFill Destination:=Range("H3:H" & Rws + 1), Type:=xlFillDefault
End If
Next J
Randomize
Target.Interior.ColorIndex = 34 + 9 * Rnd()
End If
End Sub


Sub GPE(cRg As Range)
Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sh.Range( _
"AA1:AA2"), CopyToRange:=cRg, Unique:=False
End Sub

Sub Macro1()
Range("R3").Select
ActiveCell.FormulaR1C1 = _
"=IF(TYPE(VLOOKUP(RC[-14],Sale,2,0))=16,"""",VLOOKUP(RC[-14],Sale,2,0))"
Range("R4").Select
End Sub

 

[bunbun85]

Có thì cứ xài thôi, lỗi đến đâu chỉnh đến đó - còn muốn hiểu thì bạn phải có kiến thức kha khá về VBA chứ không giải thích cũng bằng 0 àh!

 

[tranvyvn]

thì phải học hỏi nhiều mới khá được chứ. Vấn đề là thấy code này rất hay nên muốn học hỏi và ứng dụng vào công việc, tuy nhiên yêu cầu của mình đơn giản hơn nên muốn nhờ các cao thủ giải thích để sửa lại cho phù hợp, cũng là một phương pháp học hỏi mà.
Nhờ các cao thủ giúp em.

 

[Ngoai Thanh]

thì phải học hỏi nhiều mới khá được chứ. Vấn đề là thấy code này rất hay nên muốn học hỏi và ứng dụng vào công việc, tuy nhiên yêu cầu của mình đơn giản hơn nên muốn nhờ các cao thủ giải thích để sửa lại cho phù hợp, cũng là một phương pháp học hỏi mà.
Nhờ các cao thủ giúp em.

Nếu là công việc thì bạn đưa file lên nhờ giúp đỡ, nhiều người giúp code sẽ tối ưu hơn . Còn phải học hỏi mới khá được thì đúng thôi , nhưng phải "gặm" từ từ nếu ta tiêu hóa được, nếu không sẽ bội thực . Mọi thứ trên diễn đàn đều có, có điều lĩnh hội thế nào lại do khả năng của từng người . Bạn cứ sửa code theo ý mình đi, nếu không chạy hoặc lỗi thì thoát file và không ghi lại khi file thay đổi và làm lại . tất nhiên là với code đơn giản . Nếu có điều kiện thì theo học các lớp diễn đàn vẫn mở thường xuyên đó .

 

[SA_DQ]

[Thongbao]em muốn nhờ các cao thủ giải thích chi tiết để em học hỏi; Em cảm ơn mọi người.

Phần khai báo:

Option Explicit      ': Yêu cầu các biến đều fải khai báo'
Dim Rng As Range, Sh As Worksheet   ': Khai báo 2 biến đối tượng dùng chung trong toàn Module'

Private Sub Worksheet_Change(ByVal Target As Range)  'Tên macro sự kiện tại 1 vùng 1/các ô'
' 3 dòng lên dùng để khai báo các biến có cùng kiểu loại:'
Dim J As Byte, Rws As Long
Dim cRg As Range
Dim MyAdd As String

[COLOR=#0000ff]'Nếu "Ta" tác động vô ô [B1] thì:'[/COLOR]
If Not Intersect(Target, [B1]) Is Nothing Then
[COLOR=#0000ff] ' Lấy số dòng của vùng được mở rọng từ ô [B3] (ra đến các biên) đem gán vô biến Rws đã khai báo:'[/COLOR]
Rws = [B3].CurrentRegion.Rows.Count
[COLOR=#0000ff]'Xóa toàn bộ dữ liệu vùng ô bắt đầu từ [A3] mở rọng về fía dưới Rws + 9 dòng & 17 cột'[/COLOR]
[A3].Resize(Rws + 9, 17).ClearContents
[COLOR=#0000ff]'Thiết lập vòng lặp theo tham biến J từ 1 đến 2; Vòng lặp kết thúc tại dòng lệnh Next J '
[/COLOR]For J = 1 To 2
[COLOR=#0000ff]'Đem Trang tính có tên DL 1 hay 2 tùy bước vòng lặp gàn vô biến đối tượng Sh:'[/COLOR]
Set Sh = ThisWorkbook.Worksheets("DL" & CStr(J))
[COLOR=#0000ff]'Đem vùng được mở rọng đến các biên từ [B2] của trang tính đã gán vô biến Sh, đem gán vô Rng'[/COLOR]
Set Rng = Sh.[B2].CurrentRegion
[COLOR=#0000ff]'Tham biến kiểu chuỗi MyAdd lần lượt được nhận các địa chỉ vùng tương ứng theo biến đếm J'[/COLOR]
MyAdd = Choose(J, "$AC$1:$AO$1", "$AC1:$Ae$1")
[COLOR=#0000ff]'Đem vùng có địa chỉ trong biến MyAdd gán vô biến đối tượng cRg'[/COLOR]
Set cRg = Sh.Range(MyAdd)
[COLOR=#0000ff]'Thực hiện macro GPE với tham biến truyền là cRg:'[/COLOR]
GPE cRg
'Thiết lập điều kiện, nếu J =1, thì thực hiện các lệnh trước câu lệnh Else:' 
If J = 1 Then
[COLOR=#0000ff]'Lấy số dòng của vùng mở rọng từ Sh.[AC2] ra tới các biên, đem gán vô biến Rws:'[/COLOR]
Rws = Sh.[AC2].CurrentRegion.Rows.Count
[COLOR=#0000ff]'Thực hiện việc Copy dữ liệu từ Sh.[AC2] mở rọng về fía dưới Rws dòng & fải 4 cột đến ô trên trái nhất là [A3]'
[/COLOR]Sh.[AC2].Resize(Rws, 4).Copy Destination:=[A3]
Sh.[AF2].Resize(Rws, 2).Copy Destination:=[F3] [COLOR=#0000ff]'Tương tự như trên vớ các chỉ số có khác'[/COLOR]
Sh.[AI2].Resize(Rws, 6).Copy Destination:=[j3] [COLOR=#0000ff]' -NTr- . . . '[/COLOR]
Sh.[ao2].Resize(Rws).Copy Destination:=[q3]    [COLOR=#0000ff]' -NTr- . . . '
'Đ/K nếu biến ch5y J = 2: Thực hiện các lệnh cho tới trước End If'[/COLOR]
ElseIf J = 2 Then
[COLOR=#0000ff]'Lệnh gán công thức hàm VLOOKUP() của Excel cho ô [H3]:'[/COLOR]
Range("H3").FormulaR1C1 = "=VLOOKUP(RC[-4],'DL2'!R[-2]C[22]:R[" & Rws & "]C[23],2,FALSE)"
Range("H3").Select              [COLOR=#0000ff] ': Chọn ô vừa lập công thức & dùng FillDown để chép xuống dưới'[/COLOR]
Selection.AutoFill Destination:=Range("H3:H" & Rws + 1), Type:=xlFillDefault
End If
Next J
Randomize    [COLOR=#0000ff]'Tô màu cho vui:'[/COLOR]
Target.Interior.ColorIndex = 34 + 9 * Rnd()
End If
[B]End Sub[/B]

Macro GPE với tham biến kiểu vùng ô được truyền là cRg:
Macro này là 1 lệnh lọc mở rọng với vùng chuẩn là Sh.[AA1:AA2] & đưa kết quả ra vùng chứa trong tham biến cRg

Sub GPE(cRg As Range)
Rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sh.Range( _
"AA1:AA2"), CopyToRange:=cRg, Unique:=False
End Sub

Còn đây là macro được ghi do mở bộ thu:

Sub Macro1()
Range("R3").Select
ActiveCell.FormulaR1C1 = _
"=IF(TYPE(VLOOKUP(RC[-14],Sale,2,0))=16,"""",VLOOKUP(RC[-14],Sale,2,0))"
Range("R4").Select
End Sub
[/Thongbao]

 

[tranvyvn]

Em cảm ơn nhiệt tình bác
HYen17
bác là Thành viên Cằn Cỗi có khác, muốn sửa thì phải hiểu nó làm việc gì phải không bác.

 

[SA_DQ]

Tuy bạn không nêu ra; Nhưng là mình, thì mình biết ai là tác giả của macro này luôn kia đấy!

 

[tranvyvn]

Vâng. Của một cao thủ trên gpe này, em thấy nó load nhanh quá nên muốn học hỏi. Tiện đây bác cho em hỏi nếu em chỉ cần lọc dữ liệu ở DL1 tuy nhiên kết quả lọc em chỉ lấy một vài cột không liên tục thì code này phải sửa như thế nao? Bỏ lookup đi không cần tới.

 

[SA_DQ]

Vâng, em thấy nó load nhanh quá nên muốn học hỏi.
Tiện đây bác cho em hỏi nếu em chỉ cần lọc dữ liệu ở DL1 tuy nhiên kết quả lọc em chỉ lấy một vài cột không liên tục thì code này phải sửa như thế nao? Bỏ lookup đi không cần tới.

Bạn cần lấy những cột nào, thì tại trang 'BC' cần để lại các trường đó; Các trường khác ta có thể xóa tiêu đề trường đí.

Nếu chỉ lọc từ 1 trang DL1, ta ta không cần vòng lặp nữa.
Các câu lệnh liên quan đến tham số lặp J sẽ fải sửa lại hay bỏ bớt tương ứng.

Vì bạn chưa cụ thể các trường, nên mình chỉ hướng dẫn chung như vậy.

 

[tranvyvn]

Bạn cần lấy những cột nào, thì tại trang 'BC' cần để lại các trường đó; Các trường khác ta có thể xóa tiêu đề trường đí.

Nếu chỉ lọc từ 1 trang DL1, ta ta không cần vòng lặp nữa.
Các câu lệnh liên quan đến tham số lặp J sẽ fải sửa lại hay bỏ bớt tương ứng.

Vì bạn chưa cụ thể các trường, nên mình chỉ hướng dẫn chung như vậy.

Cảm ơn bác nhiều. Ví dụ ở trang DL1 em chỉ muốn lấy cột B là trường ngày và cột D, Cột E, cột H ra trang BC thì phải sửa code như thế nao

 

[Quang_Hải]

Cảm ơn bác nhiều. Ví dụ ở trang DL1 em chỉ muốn lấy cột B là trường ngày và cột D, Cột E, cột H ra trang BC thì phải sửa code như thế nao

Thay vì giải thích sao không đưa file lên sẽ có nhiều cách xử lý hơn

 

[SA_DQ]

Bạn cần sửa lại là vầy trong macro;
Còn fần trên trang tính bạn tiếp đi nha:

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim J As Byte, Rws As Long
 Dim cRg As Range
 Dim MyAdd As String
 
 If Not Intersect(Target, [B1]) Is Nothing Then
    Rws = [B3].CurrentRegion.Rows.Count
    [A3].Resize(Rws + 9, 17).ClearContents
    For J = 1 To 1          '<=|'
        Set Sh = ThisWorkbook.Worksheets("DL" & CStr(J))
        Set Rng = Sh.[B2].CurrentRegion
        MyAdd = Choose(J, "$AC$1:$Af$1", "$AC1:$Ae$1")  '<=|AO1'
        Set cRg = Sh.Range(MyAdd)
        GPE cRg
        If J = 1 Then
            Rws = Sh.[AC2].CurrentRegion.Rows.Count
            Sh.[AC2].Resize(Rws, 4).Copy Destination:=[A3]
'            Sh.[AF2].Resize(Rws, 2).Copy Destination:=[F3] '
'            Sh.[AI2].Resize(Rws, 6).Copy Destination:=[j3] '
'            Sh.[ao2].Resize(Rws).Copy Destination:=[q3]    '
        ElseIf J = 2 Then
            Range("H3").FormulaR1C1 = "=VLOOKUP(RC[-4],'DL2'!R[-2]C[22]:R[" & Rws & "]C[23],2,FALSE)"
            Range("H3").Select
            Selection.AutoFill Destination:=Range("H3:H" & Rws + 1), Type:=xlFillDefault
        End If
    Next J
    Randomize
    Target.Interior.ColorIndex = 34 + 9 * Rnd()
 End If
End Sub

Macro dưới không cần chỉnh lại trong lúc này

 

[tranvyvn]

Cảm ơn sự nhiệt tình của bác SA để em test xem sao

 

[tranvyvn]

Thay vì giải thích sao không đưa file lên sẽ có nhiều cách xử lý hơn

Bác QUANGHAI ơi em có gửi file ban đầu mà

 

[SA_DQ]

Thay vì giải thích sao không đưa file lên sẽ có nhiều cách xử lý hơn

/(hà, Khà, . . . . Mình với tác giả macro này thân như anh em trong 1 nhà, nên xem file 1 lần là đủ;

Còn chú mày thì còn chán!