[Nhờ giúp] Advance filter bằng VBA trong excel (1 người xem)

[thanhphuongvip]

Mình thì ko rành về VBA nên nhờ anh em trên diễn đàn giúp, mình có gửi một file đính kèm, vấn đề của mình là:

Thay vì dùng Advance filter để trích lọc dữ liệu theo từng chỉ tiêu ở cột B (Tr) ra mỗi sheet khác nhau, thì mình muốn dùng VBA để khi đặt tên sheet là chỉ tiêu nào thì excel tự động trích lọc cho mình tương ứng dữ liệu đó qua sheet mới. Mọi người giúp mình với ạ, Xin đa tạ.

 

[vanthinh3101]

Mình thì ko rành về VBA nên nhờ anh em trên diễn đàn giúp, mình có gửi một file đính kèm, vấn đề của mình là:

Thay vì dùng Advance filter để trích lọc dữ liệu theo từng chỉ tiêu ở cột B (Tr) ra mỗi sheet khác nhau, thì mình muốn dùng VBA để khi đặt tên sheet là chỉ tiêu nào thì excel tự động trích lọc cho mình tương ứng dữ liệu đó qua sheet mới. Mọi người giúp mình với ạ, Xin đa tạ.

Bạn tham khảo bài viết sau: http://www.giaiphapexcel.com/diendan/threads/dùng-pivottable-để-tách-sheet-và-đặt-tên-sheet.124504/
Đúng cái bạn cần nhé!

 

[thanhphuongvip]

Bạn tham khảo bài viết sau: http://www.giaiphapexcel.com/diendan/threads/dùng-pivottable-để-tách-sheet-và-đặt-tên-sheet.124504/
Đúng cái bạn cần nhé!

Cảm ơn bạn. Vấn đề là dữ liệu mình cập nhật liên tục và muốn nó chạy cập nhật thường xuyên ạ. Còn này mình làm thủ công nên ko tiện ạ!

 

[vanthinh3101]

Cảm ơn bạn. Vấn đề là dữ liệu mình cập nhật liên tục và muốn nó chạy cập nhật thường xuyên ạ. Còn này mình làm thủ công nên ko tiện ạ!

Pivot Table cũng cập nhật liên tục được mà bạn.
Bạn làm như sau:
- Sử dụng dynamic range để tạo dữ liệu nguồn
- Tạo pivot table dựa trên dữ liệu nguồn
- Khi dữ liệu nguồn thay đổi, refresh lại pivot table. Ngoài ra, bạn sử dụng code này để pivot table được tự động refresh (code của bác @kyo)

Private Sub Worksheet_Activate()
    Dim pt As PivotTable
    For Each pt In Me.PivotTables
        pt.RefreshTable
    Next
End Sub

 

[Ba Tê]

Mình thì ko rành về VBA nên nhờ anh em trên diễn đàn giúp, mình có gửi một file đính kèm, vấn đề của mình là:

Thay vì dùng Advance filter để trích lọc dữ liệu theo từng chỉ tiêu ở cột B (Tr) ra mỗi sheet khác nhau, thì mình muốn dùng VBA để khi đặt tên sheet là chỉ tiêu nào thì excel tự động trích lọc cho mình tương ứng dữ liệu đó qua sheet mới. Mọi người giúp mình với ạ, Xin đa tạ.

Bạn muốn dùng Sub thì chép cái này vào Module:

Public Sub S_GPE()
Dim sArr(), I As Long, J As Long, K As Long, R As Long, DK As String
With Sheets("NHATKY")
    sArr = .Range("B4", .Range("C4").End(xlDown)).Resize(, 13).Value
    R = UBound(sArr)
    ReDim darr(1 To R, 1 To 13)
End With
DK = UCase(ActiveSheet.Name)
For I = 1 To R
    If UCase(sArr(I, 1)) = DK Then
        K = K + 1
        For J = 1 To 13
            darr(K, J) = sArr(I, J)
        Next J
    End If
Next I
With ActiveSheet
    .Range("B4").Resize(1000, 13).ClearContents
    If K Then .Range("B4").Resize(K, 13) = darr
End With
End Sub

Chép cái này cho Sheet "acc" và Sheet "620dt", cũng cho sheet nào bạn muốn có tên sheet trong cột B "NHATKY"

Private Sub Worksheet_Activate()
S_GPE
End Sub

Chú ý: Công thức trong "NHATKY" không nên để có lỗi "N/A", VBA không chịu mấy cái ô lỗi đó.
Bẫy lỗi cho nó thành "cái giống gì đó" khác lỗi đi.
Màu mè thì tô vừa phải thôi, tô cả cột 65536 ô chỉ làm nặng nề file lên thôi, chẳng được việc gì.

 

[thanhphuongvip]

Bạn muốn dùng Sub thì chép cái này vào Module:

Public Sub S_GPE()
Dim sArr(), I As Long, J As Long, K As Long, R As Long, DK As String
With Sheets("NHATKY")
    sArr = .Range("B4", .Range("C4").End(xlDown)).Resize(, 13).Value
    R = UBound(sArr)
    ReDim darr(1 To R, 1 To 13)
End With
DK = UCase(ActiveSheet.Name)
For I = 1 To R
    If UCase(sArr(I, 1)) = DK Then
        K = K + 1
        For J = 1 To 13
            darr(K, J) = sArr(I, J)
        Next J
    End If
Next I
With ActiveSheet
    .Range("B4").Resize(1000, 13).ClearContents
    If K Then .Range("B4").Resize(K, 13) = darr
End With
End Sub

Chép cái này cho Sheet "acc" và Sheet "620dt", cũng cho sheet nào bạn muốn có tên sheet trong cột B "NHATKY"

Private Sub Worksheet_Activate()
S_GPE
End Sub

Chú ý: Công thức trong "NHATKY" không nên để có lỗi "N/A", VBA không chịu mấy cái ô lỗi đó.
Bẫy lỗi cho nó thành "cái giống gì đó" khác lỗi đi.
Màu mè thì tô vừa phải thôi, tô cả cột 65536 ô chỉ làm nặng nề file lên thôi, chẳng được việc gì.

Cảm ơn Ba Tê rất là nhiều, mình đã thử và thành công. Mình xin bạn giúp mình file Xi Măng bên dưới với, tương tự với dữ liệu ở cột E (Nhà xe) ở Sheet vận tải ạ! Xin đa tạ!

 

[Ba Tê]

Cảm ơn Ba Tê rất là nhiều, mình đã thử và thành công. Mình xin bạn giúp mình file Xi Măng bên dưới với, tương tự với dữ liệu ở cột E (Nhà xe) ở Sheet vận tải ạ! Xin đa tạ!

Cái gì cũng giải thích rõ lại từ đầu, tương tự là sao ai biết. Nhiều người khác muốn giúp nhưng biết "tương tự" là sao?
Code viết rồi là "xóa" rồi, nhớ làm gì cho "đầy não".
Chỉ chỉnh lại Sub trên, lấy dữ liệu theo cột E sheet "Vận Tải" (tên sheet không nên có dấu tiếng Việt).
Bạn muốn nó chạy cho sheet nào thì copy cái Worksheet_Activate() bên trên vào sheet đó.

Public Sub S_GPE()
Dim sArr(), I As Long, J As Long, K As Long, R As Long, DK As String
With Sheet7                  '<--------VBA không chịu tiếng Việt có dấu.'
    sArr = .Range("C6:S5000").Value
    R = UBound(sArr)
    ReDim darr(1 To R, 1 To 17)
End With
DK = UCase(ActiveSheet.Name)
For I = 1 To R
    If UCase(sArr(I, 3)) = DK Then
        K = K + 1
        For J = 1 To 17
            darr(K, J) = sArr(I, J)
        Next J
    End If
Next I
With ActiveSheet
    .Range("C6").Resize(1000, 17).ClearContents
    If K Then .Range("C6").Resize(K, 17) = darr
End With
End Sub