Lọc dữ liệu từ 1 sheet sang nhiều sheets?

Hoàng Nhật Phương · 31/10/17

Xin chào tất cả các bạn,
Nhờ các bạn giúp đỡ trường hợp lọc dữ liệu từ 1 sheet sang nhiều sheets theo điều kiện trong tập tin gửi kèm với ạ.

Hoàng Nhật Phương · 31/10/17

hpkhuong đã viết:
Tóm lại là chỉ copy qua sheet kết quả có 2 cột là Tieude3; Tieude4 hay sao?

Xin chào hpkhuong,
Dạ vâng hiện tại Sếp mới chỉ yêu cầu hàng ngày phải như vậy ạ , nhờ bạn xem giúp

Hai Lúa Miền Tây · 31/10/17

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào tất cả các bạn,
Nhờ các bạn giúp đỡ trường hợp lọc dữ liệu từ 1 sheet sang nhiều sheets theo điều kiện trong tập tin gửi kèm với ạ.

Dùng ADO thử nhé:

Mã:

Sub LocDL_HLMT()
    With CreateObject("ADODB.Connection")
        .Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 12.0"
        Sheets("Sheet2").Range("C2").CopyFromRecordset .Execute("Select Tieude3,Tieude4 From [Sheet1$C1:I] Where Tieude2='DK1' And Tieude6 Is Null")
        Sheets("Sheet3").Range("C2").CopyFromRecordset .Execute("Select Tieude3,Tieude4 From [Sheet1$C1:I] Where Tieude6='DK2'")
    End With
End Sub

SA_DQ · 31/10/17

Bạn thử với cách tàm tạm này:

PHP:

Sub CopyTo2Sheet()
 Dim Rng3 As Range, Rng2 As Range, Cls As Range
 Sheet1.Select
 For Each Cls In Range([D2], [D2].End(xlDown))
    If Cls.Value = "DK1" And Cls.Offset(, 4).Value = "" Then
        If Rng2 Is Nothing Then
            Set Rng2 = Cls.Offset(, 1).Resize(, 2)
        Else
            Set Rng2 = Union(Rng2, Cls.Offset(, 1).Resize(, 2))
        End If
    End If
    If Cls.Offset(, 4).Value = "DK2" Then
        If Rng3 Is Nothing Then
            Set Rng3 = Cls.Offset(, 1).Resize(, 2)
        Else
            Set Rng3 = Union(Rng3, Cls.Offset(, 1).Resize(, 2))
        End If
    End If
 Next Cls
 If Not Rng2 Is Nothing Then
    Sheet2.[c65500].End(xlUp).Offset(1).Resize(Rng2.Rows.Count, 2).Value = Rng2.Value
    Set Rng2 = Nothing
 End If
 If Not Rng3 Is Nothing Then
    Sheet3.[c65500].End(xlUp).Offset(1).Resize(Rng3.Rows.Count, 2).Value = Rng3.Value
    Set Rng3 = Nothing
 End If
End Sub

befaint · 31/10/17

Nguyễn Hoàng Oanh Thơ đã viết:
lọc dữ liệu từ 1 sheet sang nhiều sheets

PHP:

Sub One2More()
    Const DK1 As String = "DK1"
    Const DK2 As String = "DK2"
    Dim a(), lR As Long, b(), c()
    Dim i, j, k
    With Sheet1
        lR = .Range("C" & Rows.Count).End(xlUp).Row
        If lR = 1 Then Exit Sub
        a = .Range("D2:H" & lR).Value
        lR = UBound(a, 1)
    End With
    ReDim b(1 To lR, 1 To 2)
    ReDim c(1 To lR, 1 To 2)
    For i = 1 To lR
        If a(i, 1) = DK1 Then
            If a(i, 5) = "" Then
                j = j + 1
                b(j, 1) = a(i, 2): b(j, 2) = a(i, 3)
            ElseIf a(i, 5) = DK2 Then
                k = k + 1
                c(k, 1) = a(i, 2): c(k, 2) = a(i, 3)
            End If
        End If
    Next i
    If j Then
        Sheet2.Range("C2").Resize(100000, 2).ClearContents
        Sheet2.Range("C2").Resize(j, 2) = b
    End If
    If k Then
        Sheet3.Range("C2").Resize(100000, 2).ClearContents
        Sheet3.Range("C2").Resize(k, 2) = c
    End If
End Sub

Hoàng Nhật Phương · 31/10/17

Cảm ơn các bạn: hpkhuong,Hai Lúa Miền Tây,SA_DQ,befaint rất nhiều.

Các code trên kết quả đều đúng ý tôi mong muốn rồi ,hihi code không hề đơn giản như tôi đã nghĩ.
Code của SA_DQ, tôi có phần dễ hiểu hơn..

)

Một lần nữa cảm ơn các bạn, cảm ơn diễn đàn.

ndu96081631 · 31/10/17

Nguyễn Hoàng Oanh Thơ đã viết:
hihi code không hề đơn giản như tôi đã nghĩ.

Muốn đơn giản, dùng Advanced Filter. Cả khi làm bằng tay hay code đều dễ hiểu

Hoàng Nhật Phương · 31/10/17

ndu96081631 đã viết:
Muốn đơn giản, dùng Advanced Filter. Cả khi làm bằng tay hay code đều dễ hiểu

Xin chào ndu96081631,
Vâng nếu có thể mong bạn giúp cho đoạn code ạ.
------------------------
Oanh Thơ test thử các code trên với trường hợp dữ liệu ở sheet 1 có dòng rỗng thì code của 2 bạn hpkhuong và SA_DQ có vấn đề đối với trường hợp này thì phải ạ.
Nhờ 2 bạn xem giúp ạ.

huuthang_bd · 31/10/17

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào ndu96081631,
Vâng nếu có thể mong bạn giúp cho đoạn code ạ.

Search: Advance Filter site:giaiphapexcel.com
Muốn code thì Record Macro

Hoàng Nhật Phương · 31/10/17

huuthang_bd đã viết:
Search: Advance Filter site:giaiphapexcel.com
Muốn code thì Record Macro

Xin chào huuthang_bd,
Oanh Thơ đã thực hiện theo cách anh chỉ dẫn và kết quả Macro sau vài giờ hì hục là:

Mã:

Sub hichic()
    Sheets("Sheet1").Select
    Range("M1").Value = "Tieude2"
    Range("N1").Value = "Tieude6"
    Range("M2").Value = "DK1"
    Range("N2").FormulaR1C1 = "=""<>DK2"""
    Range("C1:I19").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "M1:N2"), CopyToRange:=Range("C22:I22"), Unique:=False
    Range("E23:F32").Copy Sheets("Sheet2").Range("C2")
    Sheets("Sheet1").Select
    Range("C22:I32").Clear
    Range("M2").ClearContents
    Range("N2").Value = "DK2"
    Range("C1:I19").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "M1:N2"), CopyToRange:=Range("C22:I22"), Unique:=False
    Range("E23:F34").Copy Sheets("Sheet3").Range("C2")
    Sheets("Sheet1").Select
    Range("C21:I34").Clear
    Range("M1:N3").Clear
    Application.CutCopyMode = False
End Sub

Nhưng code trên vẫn thuộc dạng thủ công nếu dữ liệu thay đổi dài ngắn khác nhau thì phải sửa lại code.

Nhờ Anh và các bạn chỉnh sửa giúp để làm sao cho nó linh động hơn với ạ.

SA_DQ · 31/10/17

Fải nói với bạn 1 điều là dữ liệu trong Sheet1 có hàng rỗng thì nên vứt đi, đừng xài!

huuthang_bd · 31/10/17

Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào huuthang_bd,
Oanh Thơ đã thực hiện theo cách anh chỉ dẫn và kết quả Macro sau vài giờ hì hục là:

Mã:

Sub hichic() Sheets("Sheet1").Select Range("M1").Value = "Tieude2" Range("N1").Value = "Tieude6" Range("M2").Value = "DK1" Range("N2").FormulaR1C1 = "=""<>DK2""" Range("C1:I19").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "M1:N2"), CopyToRange:=Range("C22:I22"), Unique:=False Range("E23:F32").Copy Sheets("Sheet2").Range("C2") Sheets("Sheet1").Select Range("C22:I32").Clear Range("M2").ClearContents Range("N2").Value = "DK2" Range("C1:I19").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "M1:N2"), CopyToRange:=Range("C22:I22"), Unique:=False Range("E23:F34").Copy Sheets("Sheet3").Range("C2") Sheets("Sheet1").Select Range("C21:I34").Clear Range("M1:N3").Clear Application.CutCopyMode = False End Sub

Nhưng code trên vẫn thuộc dạng thủ công nếu dữ liệu thay đổi dài ngắn khác nhau thì phải sửa lại code.
Nhờ Anh và các bạn chỉnh sửa giúp để làm sao cho nó linh động hơn với ạ.

Cái gì không biết thì hỏi ông gồ. Nếu bạn chịu khó tìm thì sẽ thấy cách phổ biến nhất có dạng như vầy.

PHP:

Range("C1:I" & [C65536].End(xlUp).Row)

Hoàng Nhật Phương · 1/11/17

SA_DQ đã viết:
Fải nói với bạn 1 điều là dữ liệu trong Sheet1 có hàng rỗng thì nên vứt đi, đừng xài!

xin chào SA_DQ,

Bạn có thể code giúp tôi một tính năng dồn dữ liệu lên các dòng rỗng mà không phải xóa dòng được không ạ?

Cảm ơn bạn rất nhiều.

SA_DQ · 1/11/17

Vì bạn không có file giả lập, nên ta trao đổi suông, thế này:

(1) Xác định dòng cuối chứa dữ liệu; Ghi trị dòng này vô 1 biến đếm
Xác định cột cuối có dữ liệu
(2) (Xác định cột xương sống của trang dữ liệu)
Tạo vòng lặp duyệt trên cột này từ biến đếm lùi đến dòng đầu của CSDL;
(2.1) Hễ gặp ô trống trên cột duyệt (coi như cả hàng (đang duyệt) sẽ là trống;
Tiến hành chép vùng vừa duyệt lên 1 hàng (dòng); Fạm vi vùng ta đã xác định được.
Tiếp tục cứ thế đến mút chỉ thì thôi!

Những mong là bạn hình dung ra vấn đề & tiến hành 1 cách thành công mĩ mãn!

Hoàng Nhật Phương · 1/11/17

HYen17 đã viết:
Vì bạn không có file giả lập, nên ta trao đổi suông, thế này:

(1) Xác định dòng cuối chứa dữ liệu; Ghi trị dòng này vô 1 biến đếm
Xác định cột cuối có dữ liệu
(2) (Xác định cột xương sống của trang dữ liệu)
Tạo vòng lặp duyệt trên cột này từ biến đếm lùi đến dòng đầu của CSDL;
(2.1) Hễ gặp ô trống trên cột duyệt (coi như cả hàng (đang duyệt) sẽ là trống;
Tiến hành chép vùng vừa duyệt lên 1 hàng (dòng); Fạm vi vùng ta đã xác định được.
Tiếp tục cứ thế đến mút chỉ thì thôi!

Những mong là bạn hình dung ra vấn đề & tiến hành 1 cách thành công mĩ mãn!

Xin chào HYen17,
Cảm ơn bạn đã gợi ý.

Thật sự với kiến thức kém cỏi của tôi lúc này tôi chưa thể viết được những dòng code trên theo gợi ý của bạn.
Xin lỗi bạn vì khi nãy tôi sử dụng điện thoại để viết bài nên không đính kèm file được.
Hiện tôi đã đính kèm file ở bài trên rồi ạ, nhờ bạn và mọi người xem giúp.

Hoang2013 · 1/11/17

hpkhuong đã viết:
. . .

Thôi mà!, Cứ cơi như bạn í chưa tự tin trước hàng hà sa số thầy cô trên GPE.COM đi vậy;

PHP:

Sub DônDòngDuLieu()
 Dim Rws As Long, Col As Byte, J As Long
 Rws = [D65500].End(xlUp).Row   'Coi Côt [D] Là Xuong Sông Cua CSDL'
 Col = [c1].End(xlToRight).Column
 For J = Rws To 2 Step -1
    If Cells(J, "D").Value = "" Then
        Cells(J + 1, "A").Resize(Rws, Col).Copy Destination:=Cells(J, "A")
    End If
 Next J
End Sub

Hoàng Nhật Phương · 1/11/17

hpkhuong đã viết:
Nói thật, không phải vì bạn ăn nói dẽo ngọt mà không bị ném đá hay nói nặng từ thành viên GPE:

1. Dữ liệu mà có dòng rỗng thì vứt đi đừng xài.
2. Bạn có hàng tá bài, hàng chục, hàng trăm bài giúp đỡ...

-> Đến bây giờ bạn đừng có nói là chưa có kinh nghiệm đưa bài lên nên còn thiếu sót

-> Tóm lại: dữ liệu có là giả lập đi nữa cũng sát với thực tế bạn xài, không ai đi sửa bài cho bạn hoài được với cái yêu cầu ngày càng đẻ ra 1 tí như vậy...

Kết: bạn đã được từng được giúp đỡ rất nhiều, đừng nói với GPE rằng "kiến thức của tôi kém cỏi". Chả ai ở GPE này mà tự nhiên biết code két đâu, toàn tự học cả đấy...
Cho nên đừng cái gì cũng hỏi, hỏi 1 lần nhưng phải học lại 10 lần cái mình hỏi.
Trong bài này, tôi nghĩ là bạn có thể tự code cho mình được rồi chứ nhỉ, sao phải đi hỏi? Nếu cứ tiếp tục như vậy thì có đến 2050 cũng còn hỏi...???

Xin chào hpkhuong,
Cảm ơn những góp ý của bạn rất nhiều. Oanh Thơ sẽ rút kinh nghiệm.

Hoang2013 đã viết:
Thôi mà!, Cứ cơi như bạn í chưa tự tin trước hàng hà sa số thầy cô trên GPE.COM đi vậy;

PHP:

Sub DônDòngDuLieu() Dim Rws As Long, Col As Byte, J As Long Rws = [D65500].End(xlUp).Row 'Coi Côt [D] Là Xuong Sông Cua CSDL' Col = [c1].End(xlToRight).Column For J = Rws To 2 Step -1 If Cells(J, "D").Value = "" Then Cells(J + 1, "A").Resize(Rws, Col).Copy Destination:=Cells(J, "A") End If Next J End Sub

Xin chào Hoang2013,
Cảm ơn bạn đã hỗ trợ.

datram · 26/8/19

mình muốn tách thành nhiều sheet theo số tài khoản, bạn nào giúp mình với đc ko ạ? mình cám ơn rất nhiều.

Lọc dữ liệu từ 1 sheet sang nhiều sheets?

Thành viên gắn bó

File đính kèm

Thành viên gắn bó

❆❆❆❆❆❆❆❆

/(hông là gì!

|||||||||||||

Thành viên gắn bó

Huyền thoại GPE

Thành viên gắn bó

File đính kèm

Chuyên gia GPE

Thành viên gắn bó

/(hông là gì!

Chuyên gia GPE

Thành viên gắn bó

File đính kèm

/(hông là gì!

Thành viên gắn bó

Thành viên gắn bó

Thành viên gắn bó

Thành viên mới

File đính kèm

Đếm ngược thời gian