Lọc dữ liệu tất cả các sheet qua sheet tổng có điều kiện (1 người xem)

lhthai · 1/11/14

Hiện nay em co file du liệu chỉ lộc được 1 sheet thôi
Nay muốn lộc tất cả các sheet qua sheet tổng theo điều kiện

Quang_Hải · 1/11/14

lhthai đã viết:
Hiện nay em co file du liệu chỉ lộc được 1 sheet thôi
Nay muốn lộc tất cả các sheet qua sheet tổng theo điều kiện

Không thể áp dụng AdvancedFilter cho bài này để lọc nhiều sheet.
Phải dùng vòng lặp để duyệt qua các sheet thôi. Nói chung là bài rất đơn giản, nhưng buộc phải dùng phương pháp khác AdvancedFilter

lacbuidoi · 1/11/14

Bạn thử cách cùi mía của mình xem sao:

Quang_Hải · 2/11/14

Nhân tiện có bài này, xin hỏi các anh chị xem làm sao để có thể dùng AdvancedFilter cho bài này. Mình nghĩ là làm được.

Let'GâuGâu · 2/11/14

quanghai1969 đã viết:
Nhân tiện có bài này, xin hỏi các anh chị xem làm sao để có thể dùng AdvancedFilter cho bài này. Mình nghĩ là làm được.

dùng advenced filter 2 nó cứ báo lổi extract range hoài
chỉ có thể làm theo cách cùi bắp này........hihihihi

Mã:

Private Sub CommandButton1_Click()
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Index >= 4 Then Exit Sub
With ws
.[A3:H65000].AdvancedFilter 1, [D1:D2]
.[A4:H65000].SpecialCells(12).Copy [a6000].End(3).Offset(1)
.ShowAllData
End With
Next
End Sub

Quang_Hải · 2/11/14

Let'GâuGâu đã viết:
dùng advenced filter 2 nó cứ báo lổi extract range hoài
chỉ có thể làm theo cách cùi bắp này........hihihihi

Mã:

Private Sub CommandButton1_Click() Dim ws As Worksheet For Each ws In Worksheets If ws.Index >= 4 Then Exit Sub With ws .[A3:H65000].AdvancedFilter 1, [D1:D2] .[A4:H65000].SpecialCells(12).Copy [a6000].End(3).Offset(1) .ShowAllData End With Next End Sub

Dùng AdvancedFilter lọc tại chỗ cũng hay cho bài này, nhưng mình sợ dữ liệu nhiều mà dùng SpecialCells có thể bị gì đó nên đang nghĩ đến AdvancedFilter 2 mới ác chứ. Chỉ là rảnh rỗi sinh nông nổi thôi. Mình làm được nhưng phải tới 2 lần For Next.

Let'GâuGâu · 2/11/14

quanghai1969 đã viết:
Dùng AdvancedFilter lọc tại chỗ cũng hay cho bài này, nhưng mình sợ dữ liệu nhiều mà dùng SpecialCells có thể bị gì đó nên đang nghĩ đến AdvancedFilter 2 mới ác chứ. Chỉ là rảnh rỗi sinh nông nổi thôi. Mình làm được nhưng phải tới 2 lần For Next.

heheeh.............code này thấy cũng chạy được, nhưng nó chép luôn mấy dòng tiêu đề qua luôn.............hichic

Mã:

Private Sub CommandButton1_Click()
Dim ws As Worksheet

For Each ws In Worksheets
If ws.Index <> 4 Then
With ws
.Range("A3:H65000").AdvancedFilter 2, [D1:D2], [j6000].End(3).Offset(1).Resize(, 8)
End With
End If
Next

End Sub

ndu96081631 · 2/11/14

Let'GâuGâu đã viết:
heheeh.............code này thấy cũng chạy được, nhưng nó chép luôn mấy dòng tiêu đề qua luôn.............hichic

Mã:

Private Sub CommandButton1_Click() Dim ws As Worksheet For Each ws In Worksheets If ws.Index <> 4 Then With ws .Range("A3:H65000").AdvancedFilter 2, [D1:D2], [j6000].End(3).Offset(1).Resize(, 8) End With End If Next End Sub

Tính từ lần thứ 2 trở đi, mỗi khi dùng AF để chép qua TOTAL, ta đánh dấu cái tiêu đề. Cuối vòng lập, xóa 1 lần là xong chứ gì
---------------------
Tập thói quen: Khi dùng AF thì phải ghi rõ tên sheet (vùng nào thuộc sheet nào đàng hoàng)

Quang_Hải · 2/11/14

Thử với ý tưởng này cũng là để thử luôn cái chức năng lưu trữ mảng của anh Dictionary
Còn đây là code theo ý tưởng xoá dòng tiêu đề của anh NDU gợi ý

PHP:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [A2:H2]) Is Nothing Then
   Dim sh As Worksheet, r&
      Range([A5], [H65536].End(3)).ClearContents
      For Each sh In Worksheets
         If sh.Name <> "TOTAL" Then
            r = [A65536].End(3).Row + 1
            sh.[A3:H10000].AdvancedFilter 2, [A1:H2], [A65536].End(3)(2)
            Cells(r, 1).EntireRow.Delete
         End If
      Next
End If
End Sub

ndu96081631 · 2/11/14

quanghai1969 đã viết:
Thử với ý tưởng này cũng là để thử luôn cái chức năng lưu trữ mảng của anh Dictionary

Cần gì phải đến Dictionary hả Hải?
Như bài 8 đã nói, tôi làm thế này:

Mã:

Sub Main()
  Dim wks As Worksheet, rngTmp As Range, Source As Range, Target As Range
  Dim n As Long, lCs As Long
  Application.ScreenUpdating = False
  With Sheets("TOTAL")
    .Range("J4:Q60000").Clear
    If IsEmpty(.Range("J3").Value) Then .Range("J3").Value = " "
    For Each wks In ThisWorkbook.Worksheets
      If UCase(wks.Name) <> "TOTAL" Then
        n = n + 1
        Set Target = .Range("J60000").End(xlUp).Offset(1)
        Set Source = wks.Range("A3:H60000")
        Source.AdvancedFilter 2, .Range("A1:H2"), Target
        lCs = Source.Columns.Count
        [COLOR=#ff0000]If n >= 2 Then
          If rngTmp Is Nothing Then
            Set rngTmp = Target.Resize(, lCs)
          Else
            Set rngTmp = Union(rngTmp, Target.Resize(, lCs))
          End If
        End If
      End If[/COLOR]
    Next
    If .Range("J3").Value = " " Then .Range("J3").ClearContents
  End With
  If n >= 2 Then rngTmp.Delete 2
  Application.ScreenUpdating = True
End Sub

Chỗ màu đỏ là đánh dấu đấy

Quang_Hải · 2/11/14

ndu96081631 đã viết:
Cần gì phải đến Dictionary hả Hải?

Em dùng Dic là với ý tưởng nếu ta cần phải tạo ra số lượng mảng mà mình không thể biết trước cần tạo ra bao nhiêu mảng để chứa dữ liệu. Từ bài này có thể ứng dụng cho những dạng code khác.
Theo anh thì có ý tưởng nào hay hơn không?

............

Viết xong mới thấy code bài số 10 của anh. Nhưng mà code bài 9 xoá dòng tiêu đề của em cũng đẹp ra phết.

ndu96081631 · 2/11/14

quanghai1969 đã viết:
Em dùng Dic là với ý tưởng nếu ta cần phải tạo ra số lượng mảng mà mình không thể biết trước cần tạo ra bao nhiêu mảng để chứa dữ liệu. Từ bài này có thể ứng dụng cho những dạng code khác.
Theo anh thì có ý tưởng nào hay hơn không?

Dic trong trường hợp này gần như không phát huy được tác dụng nào cả. Vậy sao không dùng dạng MẢNG TRONG MẢNG

Quang_Hải · 2/11/14

ndu96081631 đã viết:
Dic trong trường hợp này gần như không phát huy được tác dụng nào cả. Vậy sao không dùng dạng MẢNG TRONG MẢNG

Em có nghĩ đến ý tưởng mảng trong mảng, nhưng vấn đề là không biết có bao nhiêu mảng cần tạo ra trước vì mình chẳng biết là sẽ có bao nhiêu sheet mà.

ndu96081631 · 2/11/14

quanghai1969 đã viết:
Em có nghĩ đến ý tưởng mảng trong mảng, nhưng vấn đề là không biết có bao nhiêu mảng cần tạo ra trước vì mình chẳng biết là sẽ có bao nhiêu sheet mà.

Dùng mảng 1 chiều và mỗi phần tử trong nó là mảng 2 chiều
Với mảng 1 chiều ta ReDim Preserve được mà Hải (có bao nhiêu mảng con thì ReDim Preserve mảng lớn đến nấy)

Quang_Hải · 2/11/14

ndu96081631 đã viết:
Dùng mảng 1 chiều và mỗi phần tử trong nó là mảng 2 chiều
Với mảng 1 chiều ta ReDim Preserve được mà Hải (có bao nhiêu mảng con thì ReDim Preserve mảng lớn đến nấy)

Anh thử code mẫu theo bài này em học với. Em vẫn chưa nghĩ ra được phương án dùng mảng trong mảng cho bài này.

ndu96081631 · 2/11/14

quanghai1969 đã viết:
Anh thử code mẫu theo bài này em học với. Em vẫn chưa nghĩ ra được phương án dùng mảng trong mảng cho bài này.

Code của Hải tại bài 9 tôi để y nguyên nhé, chỉ bỏ dictionary và thay bằng mảng 1 chiều:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, [A2:H2]) Is Nothing Then
    [COLOR=#ff0000]Dim arr()[/COLOR]
    Dim sh As Worksheet, k&, i&, Temp(), Res()
   'With CreateObject("scripting.dictionary")
      For Each sh In Worksheets
         If sh.Name <> "TOTAL" Then
            sh.[A3:H10000].AdvancedFilter 2, [A1:H2], [A4:H4]
            If [A5] <> "" Then
               k = k + 1
               Temp = Range([A5], [H65536].End(3)).Value
               '.Add k, Temp
               [COLOR=#ff0000]ReDim Preserve arr(1 To k)
               arr(k) = Temp[/COLOR]
            End If
         End If
      Next
      Range([A5], [H65536].End(3)(2)).ClearContents
      If k > 0 Then
         For i = 1 To k
            [COLOR=#ff0000]Res = arr(i)[/COLOR]
            [A65536].End(3)(2).Resize(UBound(Res), UBound(Res, 2)) = Res
         Next
      End If
   'End With
  End If
End Sub

Vậy thôi

Quang_Hải · 2/11/14

ndu96081631 đã viết:

Code của Hải tại bài 9 tôi để y nguyên nhé, chỉ bỏ dictionary và thay bằng mảng 1 chiều:

Mã:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, [A2:H2]) Is Nothing Then
    [COLOR=#ff0000]Dim arr()[/COLOR]
    Dim sh As Worksheet, k&, i&, Temp(), Res()
   'With CreateObject("scripting.dictionary")
      For Each sh In Worksheets
         If sh.Name <> "TOTAL" Then
            sh.[A3:H10000].AdvancedFilter 2, [A1:H2], [A4:H4]
            If [A5] <> "" Then
               k = k + 1
               Temp = Range([A5], [H65536].End(3)).Value
               '.Add k, Temp
               [COLOR=#ff0000]ReDim Preserve arr(1 To k)
               arr(k) = Temp[/COLOR]
            End If
         End If
      Next
      Range([A5], [H65536].End(3)(2)).ClearContents
      If k > 0 Then
         For i = 1 To k
            [COLOR=#ff0000]Res = arr(i)[/COLOR]
            [A65536].End(3)(2).Resize(UBound(Res), UBound(Res, 2)) = Res
         Next
      End If
   'End With
  End If
End Sub

Vậy thôi

Em mụ mẫm mất rồi. Chỉ có vậy mà chẳng nghĩ ra. Toàn là nghĩ đâu đâu.

lhthai · 2/11/14

ndu96081631 đã viết:

Cần gì phải đến Dictionary hả Hải?
Như bài 8 đã nói, tôi làm thế này:

Mã:

Sub Main()
  Dim wks As Worksheet, rngTmp As Range, Source As Range, Target As Range
  Dim n As Long, lCs As Long
  Application.ScreenUpdating = False
  With Sheets("TOTAL")
    .Range("J4:Q60000").Clear
    If IsEmpty(.Range("J3").Value) Then .Range("J3").Value = " "
    For Each wks In ThisWorkbook.Worksheets
      If UCase(wks.Name) <> "TOTAL" Then
        n = n + 1
        Set Target = .Range("J60000").End(xlUp).Offset(1)
        Set Source = wks.Range("A3:H60000")
        Source.AdvancedFilter 2, .Range("A1:H2"), Target
        lCs = Source.Columns.Count
        [COLOR=#ff0000]If n >= 2 Then
          If rngTmp Is Nothing Then
            Set rngTmp = Target.Resize(, lCs)
          Else
            Set rngTmp = Union(rngTmp, Target.Resize(, lCs))
          End If
        End If
      End If[/COLOR]
    Next
    If .Range("J3").Value = " " Then .Range("J3").ClearContents
  End With
  If n >= 2 Then rngTmp.Delete 2
  Application.ScreenUpdating = True
End Sub

Chỗ màu đỏ là đánh dấu đấy

Cám anh nha
Nhưng em chi thấy lộc được có một điều kiện thôi
Anh có thể bổ sung thêm nhiều điều kiện như AdvancedFilter được không

ndu96081631 · 3/11/14

lhthai đã viết:
Cám anh nha
Nhưng em chi thấy lộc được có một điều kiện thôi
Anh có thể bổ sung thêm nhiều điều kiện như AdvancedFilter được không

Tôi thấy trong file có dùng code của bài 10:

Mã:

Private Sub CommandButton2_Click()
   Dim wks As Worksheet, rngTmp As Range, Source As Range, Target As Range
  Dim n As Long, lCs As Long
  Application.ScreenUpdating = False
  With Sheets("TOTAL")
    .Range("J4:Q60000").Clear
    If IsEmpty(.Range("J3").Value) Then .Range("J3").Value = " "
    For Each wks In ThisWorkbook.Worksheets
      If UCase(wks.Name) <> "TOTAL" Then
        n = n + 1
        Set Target = .Range("J60000").End(xlUp).Offset(1)
        Set Source = wks.Range("A3:H60000")
        Source.AdvancedFilter 2,[COLOR=#ff0000] .Range("A1:H2")[/COLOR], Target
        lCs = Source.Columns.Count
        If n >= 2 Then
          If rngTmp Is Nothing Then
            Set rngTmp = Target.Resize(, lCs)
          Else
            Set rngTmp = Union(rngTmp, Target.Resize(, lCs))
          End If
        End If
      End If
    Next
    If .Range("J3").Value = " " Then .Range("J3").ClearContents
  End With
  If n >= 2 Then rngTmp.Delete 2
  Application.ScreenUpdating = True
End Sub

Chỗ màu đỏ bạn sửa thành .Range("A1:H2").CurrentRegion là được rồi. Đó chính là vùng điều kiện, sửa cho phù hợp với thực tế nó sẽ chạy chính xác ngay

Lọc dữ liệu tất cả các sheet qua sheet tổng có điều kiện (1 người xem)

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

Thành viên thường trực

Thành viên gạo cội

Thành viên mới

File đính kèm

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Thành viên mới

Huyền thoại GPE

Thành viên gạo cội

File đính kèm

Huyền thoại GPE

Thành viên gạo cội

Huyền thoại GPE

Thành viên gạo cội

Huyền thoại GPE

Thành viên gạo cội

Huyền thoại GPE

Thành viên gạo cội

Thành viên thường trực

Huyền thoại GPE

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