Giúp lọc dữ liệu (1 người xem)

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

khonghoithinguhocdungchem

Thành viên mới
Tham gia
20/10/15
Bài viết
39
Được thích
0
Mặc dù có một số bài viết về lọc dữ liệu nhưng thực sự em áp dụng vào nó toàn bằng 0 hoặc không lọc được khoảng trống.
với lại em mới học nên chưa biét nhiều lắm, mong mọi người tìm giúp em phương án giai quyết và gửi lên cho em ạ, mọi thông tin em ghi trong file đính kèm rồi.
có một bảng ở shéét 1 muốn lọc sang sheet 2 ạ
 

File đính kèm

Thì bạn cứ lọc duy nhất; Sau đó xếp lại cột theo trình tự giảm dần (để hô biến ô trống)

Sau đó xếp lại theo trật tự nào đó bạn muốn;

Đừng nói với mình là bạn muốn trình tự bạn đầu í nha! (Lúc í fải thêm vài công đoạn nữa, chắc vậy!)
 
Mặc dù có một số bài viết về lọc dữ liệu nhưng thực sự em áp dụng vào nó toàn bằng 0 hoặc không lọc được khoảng trống.
với lại em mới học nên chưa biét nhiều lắm, mong mọi người tìm giúp em phương án giai quyết và gửi lên cho em ạ, mọi thông tin em ghi trong file đính kèm rồi.
có một bảng ở shéét 1 muốn lọc sang sheet 2 ạ
Khiếp đổi Nick mới với tên mới thấy sợ
chép code sau vào chạy ra kết quả như Sheets("can loc")..Bôi màu vàng nha...nếu la nữa thì chạy...................--=0--=0
PHP:
Sub Loc_DuyNhat()
Dim Nguon(), Kq(), i&, k&
Nguon = Sheet1.Range(Sheet1.[A3], Sheet1.[A65536].End(3)).Value
ReDim Kq(1 To UBound(Nguon, 1), 1 To 1)
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(Nguon, 1)
        If Not .exists(Nguon(i, 1)) Then
            k = k + 1
            .Add Nguon(i, 1), ""
            Kq(k, 1) = Nguon(i, 1)
        End If
    Next
End With
Sheet3.Range("C4").Resize(k, 1) = Kq
End Sub
 
nhưng làm thế nào để nó chạy tự động bạn, vì cứ phải ấn F5 hoặc là tạo nút ấn thì phiền lắm
 
Lần chỉnh sửa cuối:
thực sự thì làm theo bạn nếu ấn f5 hay tạo nút thì được nhưng kể cả enable macro rồi nhưng vẫn không tự động chạy, nếu thay đổi dữ liệu ở sheet1
 
Lần chỉnh sửa cuối:
thực sự thì làm theo bạn nếu ấn f5 hay tạo nút thì được nhưng kể cả enable macro rồi nhưng vẫn không tự động chạy, nếu thay đổi dữ liệu ở sheet1
Copy Code Sau vào Sheets("can loc") trong VBA thì khi chuyên sheet là nó chạy
PHP:
Private Sub Worksheet_Activate()
Dim Nguon(), Kq(), i&, k&
Nguon = Sheet1.Range(Sheet1.[A3], Sheet1.[A65536].End(3)).Value
ReDim Kq(1 To UBound(Nguon, 1), 1 To 1)
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(Nguon, 1)
        If Not .exists(Nguon(i, 1)) Then
            k = k + 1
            .Add Nguon(i, 1), ""
            Kq(k, 1) = Nguon(i, 1)
        End If
    Next
End With
Range("A4").Resize(k * 3) = Kq
End Sub
 

File đính kèm

ok rồi bạn cảm ơn bạn rất rất nhiều, nhưng mỗi tội áp dụng vào bài tập lớn thì nó lại không lọc được khoảng trống nhỉ
 
Lần chỉnh sửa cuối:
thêm quả code sắp xếp à, thì em mới học nên có biết gì đâu nên mới cần anh giúp hì
 
Lần chỉnh sửa cuối:
bác kieu manh phát sinh thêm một lỗi là khi mà sắp xếp có số 0. em muốn sắp xếp cho số 0 xuống cuối cùng được không a mong bác chém ít thôi ạ, giúp em ca nay.
 
ok vẫn file cũ thôi ạ, nhưng giờ nếu có số 0 ở trong sheet thưc pham, sau khi loc thì có ở sheet3, sắp xếp làm sao để số 0 ở cuối cùng ạ chứ không phải ở đầu hàng như file ạ
 

File đính kèm

Copy Code Sau vào Sheets("can loc") trong VBA thì khi chuyên sheet là nó chạy
PHP:
Private Sub Worksheet_Activate()
Dim Nguon(), Kq(), i&, k&
Nguon = Sheet1.Range(Sheet1.[A3], Sheet1.[A65536].End(3)).Value
ReDim Kq(1 To UBound(Nguon, 1), 1 To 1)
With CreateObject("scripting.dictionary")
    For i = 1 To UBound(Nguon, 1)
        If Not .exists(Nguon(i, 1)) Then
            k = k + 1
            .Add Nguon(i, 1), ""
            Kq(k, 1) = Nguon(i, 1)
        End If
    Next
End With
Range("A4").Resize(k * 3) = Kq
End Sub
sao kieu manh dùng dao mổ trâu đi giết bồ câu vậy ka.chỉ cần vầy là ok rồi. code của kiều mạnh để dùng cho việc khác nhé--=0--=0
PHP:
Private Sub Worksheet_Activate()
Sheet3.Cells.Clear
Sheet1.Range("A2:A65000").AdvancedFilter 2, , [a5], True
Sheet3.Range("A6:A" & [a65000].End(3).Row).Sort [a5], 2
Sheet3.Range("A6:a" & [a65000].End(3).Row - 1).Sort [a5], 1
End Sub
 
sao kieu manh dùng dao mổ trâu đi giết bồ câu vậy ka.chỉ cần vầy là ok rồi. code của kiều mạnh để dùng cho việc khác nhé--=0--=0
PHP:
Private Sub Worksheet_Activate()
Sheet3.Cells.Clear
Sheet1.Range("A2:A65000").AdvancedFilter 2, , [a5], True
Sheet3.Range("A6:A" & [a65000].End(3).Row).Sort [a5], 2
Sheet3.Range("A6:a" & [a65000].End(3).Row - 1).Sort [a5], 1
End Sub
Thưc ra hôm trước ở thớt khác họ hỏi thì làm cho họ như sau rồi họ keo lỗi khả năng họ xài Office 2003 nên ko xài RemoveDuplicates được
PHP:
Sub LocDuyNhat()
With Sheet3
     .Range("C5:C1003").Value = Sheet1.Range("A2:A1000").Value 
     .Range("$C$6:$C$1000").RemoveDuplicates Array(1)
     .Range("C6", [C65000].End(3)).Sort [C6]
End With
End Sub
 
trân trọng cảm ơn ý kiến của các bạn ạ. mình đã fix được rồi theo ý kiến của Lê Duy Thương nhưng giờ muốn sửa đoạn code trên thành nó tự động 100% chứ không phải chuyển sheet nó mới chạy thì làm thế nào ạ. Lê Duy Thương,kieu manh
code này a
Private Sub Worksheet_Activate()
Sheet3.Cells.Clear
Sheet1
.Range("A2:A65000").AdvancedFilter 2, , [a5], True
Sheet3
.Range("A6:A" & [a65000].End(3).Row).Sort [a5], 2
Sheet3
.Range("A6:a" & [a65000].End(3).Row - 1).Sort [a5], 1
End Sub
 
Lần chỉnh sửa cuối:
lỗi gì ở dòng bôi đỏ vậy moi người
Private Sub Worksheet_Activate()

Sheet80.Range("B12:B36").ClearContents
Sheet59.Range("A3:A65000").AdvancedFilter 2, , [B12], Unique:=True
Sheet80.Range("B12:B" & [B65000].End(3).Row).Sort [B11], 2
Sheet80.Range("B12:B" & [B65000].End(3).Row - 1).Sort [B11], 1
End Sub
 
lỗi gì ở dòng bôi đỏ vậy moi người
Private Sub Worksheet_Activate()

Sheet80.Range("B12:B36").ClearContents
Sheet59.Range("A3:A65000").AdvancedFilter 2, , [B12], Unique:=True
Sheet80.Range("B12:B" & [B65000].End(3).Row).Sort [B11], 2
Sheet80.Range("B12:B" & [B65000].End(3).Row - 1).Sort [B11], 1
End Sub
LỖI Ở ĐÂY
Unique:=True THAY BẰNG ,TRUE
 

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

Back
Top Bottom