Giúp đỡ lọc số liệu sang sheet khác (1 người xem)

[vnmoney]

Em có file dữ liệu dịch vụ gồm nhiều loại dịch vụ muốn lọc những ND nào có cùng loại dịch vụ sang mọt sheet khác.
ví dụ: tại sheet DICHVU_UR11
1 hàng có ND=3623038,NE=001-37-075,TY=KLA+ SR10+ DSM,CAT=CAX2+ DF13+DIPA+ ZG2:
Thì ND=3623038 sẽ được lọc sang các sheet DSM, sheet SR10, sheet DF13.
Nhờ Anh chị giúp đỡ.E xin cảm ơn!
http://www.mediafire.com/?sharekey=bd26186eed3ac708312dbd5f2bdc5062e04e75f6e8ebb871

 

[sealand]

Mình làm được rồi mà chả biết gửi ra sao (File lớn quá đành xoá bớt dữ liệu vậy)
Ndu à: Thực ra đây là file bạn ấy kết xuất từ Table dữ liệu của phần mềm nào đó nên cấu trúc nó vậy thôi. Thông cảm bạn ấy 1 chút vì là bài đầu mà và vnmoney nên giải thích rõ ràng hơn trong lần sau.

 

[ndu96081631]

Mình làm được rồi mà chả biết gửi ra sao (File lớn quá đành xoá bớt dữ liệu vậy)
Ndu à: Thực ra đây là file bạn ấy kết xuất từ Table dữ liệu của phần mềm nào đó nên cấu trúc nó vậy thôi. Thông cảm bạn ấy 1 chút vì là bài đầu mà và vnmoney nên giải thích rõ ràng hơn trong lần sau.

Xem file của anh mới hiểu được đấy! Cảm ơn anh!
Có 1 trục trặc nhỏ mà em phát hiện ra: Do anh dùng Find để tìm, vì thế nếu tìm được SR10 thì đồng nghĩa cũng sẽ tìm thấy SR1
Ý em muốn nói: Làm sao anh phân biệt được sự khác nhau giửa 2 giá trị: SR1 và SR10
Đây chính là mấu chốt!
Nếu em làm bằng VBA thì vấn đề này khá dể giải quyết (em dùng AutoFilter để lọc)
------------
Dưới đây là file đính kèm:
- Tôi đề xuất lọc ra 1 sheet (thay vì nhiều sheet)
- Muốn lọc tham số nào thì chọn vào Validation
Code đây:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Clls As Range
  On Error Resume Next
  If Target.Address = "$B$1" Then
    Application.ScreenUpdating = False
    Range("A2:A65536").ClearContents
    With Sheet1.Range("A1").CurrentRegion
      .AutoFilter 1, "*" & Target & "*", xlAnd, IIf(Target = "SR10", "*", "<>*SR10*")
      .Offset(1).SpecialCells(12).Copy
      Range("A2").PasteSpecial 3
      .AutoFilter
    End With
    For Each Clls In Range([A2], [A65536].End(xlUp))
      Clls = Mid(Clls, 1, InStr(Clls, ",") - 1)
    Next Clls
    Target.Select
    Application.ScreenUpdating = True
  End If
End Sub

 

[vnmoney]

Có 1 trục trặc nhỏ mà em phát hiện ra: Do anh dùng Find để tìm, vì thế nếu tìm được SR10 thì đồng nghĩa cũng sẽ tìm thấy SR1
Ý em muốn nói: Làm sao anh phân biệt được sự khác nhau giửa 2 giá trị: SR1 và SR10
Đây chính là mấu chốt!
Nếu em làm bằng VBA thì vấn đề này khá dể giải quyết (em dùng AutoFilter để lọc)
------------
Dưới đây là file đính kèm:
- Tôi đề xuất lọc ra 1 sheet (thay vì nhiều sheet)
- Muốn lọc tham số nào thì chọn vào Validation
Code đây:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Clls As Range
  On Error Resume Next
  If Target.Address = "$B$1" Then
    Application.ScreenUpdating = False
    Range("A2:A65536").ClearContents
    With Sheet1.Range("A1").CurrentRegion
      .AutoFilter 1, "*" & Target & "*", xlAnd, IIf(Target = "SR10", "*", "<>*SR10*")
      .Offset(1).SpecialCells(12).Copy
      Range("A2").PasteSpecial 3
      .AutoFilter
    End With
    For Each Clls In Range([A2], [A65536].End(xlUp))
      Clls = Mid(Clls, 1, InStr(Clls, ",") - 1)
    Next Clls
    Target.Select
    Application.ScreenUpdating = True
  End If
End Sub

[/quote]

Cách của anh rất hay, chỉ cần lọc ra 1 sheet, nếu muốn trích thêm các tên khác chỉ cần chọn vào Validation để bổ xung.Cảm ơn anh nhiều!

 

[sealand]

Cám ơn Ndu đã nhắc nhở khá chuẩn xác, chính vì lý do vậy khi lọc chuỗi trong phần mền Kế toán cũng có vấn đề này. Khi lọc người ta lọc có thêm dấu phảy trong dãy danh sách các tài khoản để xác định kết thúc chuỗi

 

[vnmoney]

Nhờ anh ndu96081631 xem lại hộ em hình như có vấn đề khi lọc tham số
Ví dụ: Trên sheet số liệu gốc dùng hàm Find để tìm tham số DSM thì đếm được có 11568 cell.Như vậy khi Trích theo DSM thì phải có 11568 Số máy có DSM nhưng khi em trích theo DSM thì chỉ lọc ra được 1192 số máy thôi, thiếu mất 10376 số máy
http://www.filesavr.com/dichvuttvt1_1

http://www.mediafire.com/?sharekey=bd26186eed3ac708312dbd5f2bdc5062e04e75f6e8ebb871

file dịch vụ TTVT1 đấy anh ạ.Link kia em down thử vẫn ok.

 

[ndu96081631]

http://www.mediafire.com/?sharekey=bd26186eed3ac708312dbd5f2bdc5062e04e75f6e8ebb871

file dịch vụ TTVT1 đấy anh ạ.Link kia em down thử vẫn ok.

Tôi vừa xem file xong!
Lý do nó lọc thiếu là vì trong sheet gốc của bạn có dòng rổng
Vậy sẽ có 2 cách:
- Xóa hết dòng rổng
- Nếu không muốn xóa dòng rổng thì thay đoạn:
With Sheet1.Range("A1").CurrentRegion
Thành:
With Sheet1.Range(Sheet1.[A1], Sheet1.[A65536].End(xlUp))
-------------------
Tuy nhiên vấn đề không phải chỉ bấy nhiêu đó thôi ---> Tôi phát hiện ra 1 lổi nghiêm trọng: Với dử liệu lớn như file của bạn thì:
- Offset không làm việc được
- SpecialcelCells cũng không làm việc được
- Mở file trên Excel 2007 cũng không giải quyết được lổi trên
Vì thế mà chẳng copy được tí gì
Vậy chẳng lẻ phải dùng For quét toàn bộ dử liệu sao trời?

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Clls As Range
  On Error Resume Next
  If Target.Address = "$B$1" Then
    Application.ScreenUpdating = False
    Range("A2:A65536").ClearContents
    With Sheet1.Range(Sheet1.[A1], Sheet1.[A65536].End(xlUp))
      For Each Clls In .Cells
        If InStr(Clls, Target) Then
          Range("A65536").End(xlUp).Offset(1) = Mid(Clls, 1, InStr(Clls, ",") - 1)
        End If
      Next
    End With
    Target.Select
    Application.ScreenUpdating = True
  End If
End Sub

Thế này thì chậm lắm!
Các cao thủ ai có cao kiến gì không?

 

[ndu96081631]

Ah... tôi đã tìm ra giải pháp: Tạm thời chia dử liệu gốc ra thành 3 đoạn để copy, mổi đoạn 21845 dòng (vị chi 3 đoạn là 65535 dòng)
code như sau:

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Clls As Range, i As Long
  'On Error Resume Next
  If Target.Address = "$B$1" Then
    Application.ScreenUpdating = False
    Range("A2:A65536").ClearContents
    With Sheet1.Range(Sheet1.[A1], Sheet1.[A65536].End(xlUp))
      .AutoFilter 1, "*" & Target & "*", xlAnd, IIf(Target = "SR10", "*", "<>*SR10*")
      For i = 1 To 3
        Sheet1.Range("A1").Offset((i - 1) * 21845 + 1).Resize(21845).SpecialCells(12).Copy
        Range("A65536").End(xlUp).Offset(1).PasteSpecial 3
      Next i
      .AutoFilter
    End With
    For Each Clls In Range([A2], [A65536].End(xlUp))
      Clls = Mid(Clls, 1, InStr(Clls, ",") - 1)
    Next Clls
    Target.Select
    Application.ScreenUpdating = True
  End If
End Sub

Với code này, lọc xong với điều kiện DSM rồi kiểm tra lại bằng hàm Search vẫn thấy thiếu mất vài dòng ---> Không hiểu nguyên nhân từ đâu nữa ---> Riêng các điều kiện lọc khác thì đúng
Lưu ý với tác giả: File của bạn nhiểm virus rất nặng đấy nhé (có thể đã lây nhiểm toàn bộ file trên máy tính của bạn rồi) ---> Cẩn thận nhé
File này đã diệt virus

 

[vnmoney]

Chuẩn rồi anh ndu96081631

Dùng For quét toàn bộ dử liệu là chuẩn nhất anh ạ, cũng không chậm lắm đâu.Dùng cách chia dử liệu gốc ra thành 3 đoạn để copy thì lọc với điều kiện DSM thì thiếu hơn 10 dòng mà tốc độ cũng như dùng For quét.
Cho em hỏi thêm tí, nếu lọc theo các điều kiện DSM,RVT.... mà dòng đó có tham số DF13 thì có thể copy được tham số DF13 sang cùng không.

 

[ndu96081631]

Dùng For quét toàn bộ dử liệu là chuẩn nhất anh ạ, cũng không chậm lắm đâu.Dùng cách chia dử liệu gốc ra thành 3 đoạn để copy thì lọc với điều kiện DSM thì thiếu hơn 10 dòng mà tốc độ cũng như dùng For quét.
Cho em hỏi thêm tí, nếu lọc theo các điều kiện DSM,RVT.... mà dòng đó có tham số DF13 thì có thể copy được tham số DF13 sang cùng không.

Chưa chắc chuẩn đâu... vẫn còn sai đấy! Sai ở chổ khi bạn lọc SR1 thì nó lấy luôn SR10 (hay nói chung các mã có dạng SR1xx) ---> Để tôi suy nghĩ xem có cách nào khác không!

Cho em hỏi thêm tí, nếu lọc theo các điều kiện DSM,RVT.... mà dòng đó có tham số DF13 thì có thể copy được tham số DF13 sang cùng không.

Chưa hiểu lắm ---> Copy tham số DF13 rồi "ráp" vào đâu?

 

[vnmoney]

Chưa chắc chuẩn đâu... vẫn còn sai đấy! Sai ở chổ khi bạn lọc SR1 thì nó lấy luôn SR10 (hay nói chung các mã có dạng SR1xx) ---> Để tôi suy nghĩ xem có cách nào khác không!

Chưa hiểu lắm ---> Copy tham số DF13 rồi "ráp" vào đâu?

Em muốn Copy tham số DF13 sang 1 cột khác như là 1 cột ghi chú đấy.

Số máy Ghi chú
ND=3656344 DF13
http://www.mediafire.com/?sharekey=bd26186eed3ac708312dbd5f2bdc5062e04e75f6e8ebb871

 

[vnmoney]

Anh ndu96081631 đâu rồi nhỉ

Anh khỏe chứ.Anh có cao kiến gì chưa?

 

[ndu96081631]

Em muốn Copy tham số DF13 sang 1 cột khác như là 1 cột ghi chú đấy.

Số máy Ghi chú
ND=3656344 DF13
http://www.mediafire.com/?sharekey=bd26186eed3ac708312dbd5f2bdc5062e04e75f6e8ebb871

Tạm thời làm thế này nha (Dùng Advanced Filter, còn AutoFilter thì thua rồi)

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim Clls As Range
  On Error Resume Next
  If Target.Address = "$B$1" Then
    Application.ScreenUpdating = False
    Range("A1:A65536").ClearContents
    With Sheet1.Range(Sheet1.[A1], Sheet1.[A65536].End(xlUp))
      .AdvancedFilter 2, .Parent.[C1:C2], [A1]
    End With
    With Range([A1], [A65536].End(xlUp))
      If Target = "SR1" Then
        .AutoFilter 1, "*SR10*", xlOr, "*SR14*"
        .Offset(1).SpecialCells(12).EntireRow.Delete
        .AutoFilter
      End If
      For Each Clls In .Offset(1)
        If InStr(Clls, "DF13") And Target <> "DF13" Then
          Clls = Mid(Clls, 1, InStr(Clls, ",") - 1) & " DF13"
        Else
          Clls = Mid(Clls, 1, InStr(Clls, ",") - 1)
        End If
      Next Clls
    End With
    Target.Select
    Application.ScreenUpdating = True
  End If
End Sub

Cảm giác vẫn chưa chính xác lắm nhưng tôi chưa tìm được nguyên nhân!
Bạn test lại xem (và nhớ báo tôi biết nếu phát hiện chổ không chính xác nhé... Vả quá)