Lọc và giữ lại giá trị đầu tiên (1 người xem)

[lenguyenleduong]

Xin các bác giúp em cách Lọc ra những mã hàng trùng nhau và chỉ giữ lại mã hàng đầu tiên (như file excel em đã trình bày). Sau đó copy bảng lọc được sang sheet khác. Em xin cám ơn các bác.

 

[ChanhTQ@]

Macro của bạn đây, xin mời

Option Explicit

Sub LocMaDuyNhatTheoNhom()
 Dim Sh As Worksheet, Rng As Range, Clls As Range
 Dim Ma As String:                              Dim eRw As Long
     
 Sheets("GOC").Select:                          Set Sh = Sheets("Loc")
 eRw = [A4].CurrentRegion.Rows.Count:           Sh.[b7].Resize(eRw, 2).ClearContents
 Set Rng = [A4].Resize(eRw, 2)
 Rng.Sort Key1:=[A5], Order1:=xlAscending, Key2:=[B5], Order2:=xlAscending, Header:=xlGuess
 For Each Clls In Rng.Cells(2, 1).Resize(eRw)
   With Sh.[c65500].End(xlUp).Offset(1)
      If Ma <> Clls.Value Then
         Ma = Clls.Value:                       .Offset(, -1).Value = Ma
      End If
      .Value = Clls.Offset(, 1).Value
   End With
 Next Clls
End Sub

 

[TrungChinhs]

Xin các bác giúp em cách Lọc ra những mã hàng trùng nhau và chỉ giữ lại mã hàng đầu tiên (như file excel em đã trình bày). Sau đó copy bảng lọc được sang sheet khác. Em xin cám ơn các bác.

Sub Loc()
    Sheets("LOC").[b6:c1000].ClearContents
    Sheets("GOC").[a4].CurrentRegion.Copy Sheets("LOC").[b5]
    With Sheets("LOC").[b5:b1000].SpecialCells(2)
        For i = .Cells.Count To 1 Step -1
         If .Cells(i) = .Cells(i)(0) Then .Cells(i).ClearContents
        Next
    End With
    Sheets("LOC").Select
End Sub

Tôi không hiểu tại sao bạn phải làm cho Sheet GOC và Sheet LOC giống nhau ? vì vậy tôi chỉ làm cho Sheet LOC theo yêu cầu của bạn còn Sheet GOC vẫn giữ nguyên. Bạn xem File đính kèm (nếu bạn vẫn giữ nguyên ý kiến thì cho tôi biết để sửa lại)

 

[lenguyenleduong]

Lỗi của em không trình bày rõ ràng. Em xin lỗi và cám ơn bác Trung Chính. Ý của em là chỉ thực hiện trên 1 sheet GOC thôi ạ.

 

[TrungChinhs]

Lỗi của em không trình bày rõ ràng. Em xin lỗi và cám ơn bác Trung Chính. Ý của em là chỉ thực hiện trên 1 sheet GOC thôi ạ.

Vậy thì Code như sau

Sub Loc()
    With [b5:b1000].SpecialCells(2)
        For i = .Cells.Count To 1 Step -1
         If .Cells(i) = .Cells(i)(0) Then .Cells(i).ClearContents
        Next
    End With
End Sub

 

[ndu96081631]

Xin các bác giúp em cách Lọc ra những mã hàng trùng nhau và chỉ giữ lại mã hàng đầu tiên (như file excel em đã trình bày). Sau đó copy bảng lọc được sang sheet khác. Em xin cám ơn các bác.

Giá như bạn biết dùng đến PivotTalbe thì bài này chỉ 5s thao tác là ra mà không cần đến 1 tí code hay công thức nào!
Bạn thử xem... Nói chung công cụ có sẳn luôn là VÔ ĐỊCH

 

[lenguyenleduong]

Em cám ơn bác ndu96081631 đã có lời. Thật tình là em không nghiên cứu về excel nhiều. Em rành về visual basic nên rất có hứng thú với VBA.

 

[ndu96081631]

Em cácm ơn bác ndu96081631 đã có lời. Thật tình là em không nghiên cứu về excel nhiều. Em rành về visual basic nên rất có hứng thú với VBA.

VBA hay VB thì đúng là món tuyệt chiêu rồi, khỏi cần bàn ---> Ở đây tôi muốn nói rằng: TÙY CHUYỆN MÀ XÀI, không phải bất cứ thứ gì dùng VBA cũng là tốt nhất
Tự xây dựng 1 cái đã có sẳn, chắc gì đã tốt hơn ---> mà 99.99% là khộng thể tốt hơn được... vì 1 mình ta sao có thể so sánh với cả 1 tập thể lập trình viên dồi dào kinh nghiệm của Microsoft
(Cái trò này gần giống với việc 1 số người ngồi trên máy tính mà cứ phải sắm 1 Calculator để tính toán thì đúng là chuyện không thể chấp nhận được)

 

[ndu96081631]

Để thi với sư phụ và anh Trung Chinh về tốc độ khi dùng VBA xem

Sub Loc()
  Dim Clls As Range, FRng As Range, Rws As Long, FAdd As String
  On Error Resume Next
  With Range("B4").CurrentRegion
    If .Resize(, 1).SpecialCells(4) Is Nothing Then
      .Sort .Cells(1, 1), 1, , , , , , xlYes
      With .Resize(, 1)
        Set FRng = .Find("*", , xlValues)
        FAdd = FRng.Address
        Do
          Rws = WorksheetFunction.CountIf(.Cells, FRng.Value)
          If Rws > 1 Then FRng.Offset(1).Resize(Rws - 1).ClearContents
          Set FRng = .FindNext(FRng)
        Loop Until FRng.Address = FAdd
      End With
    End If
  End With
End Sub

Dù rằng code có dài hơn nhưng nếu dữ liệu lớn và có càng nhiều cell trùng thì code trên càng thể hiện sự vượt trội về tốc độ (vì nó xóa nhiều cell cùng lúc nên số lần lập ít hơn, không quét toàn bộ các cell)