GIúp Sửa code lọc mã hàng nếu trùng lấy dòng dưới

[minhtuan55]

Chào cả nhà GPE ! Chúc cả nhà Sunday rực rỡ thành công !
Em đang cần 1 đoạn cần 1 đoạn code lọc mã hàng nếu trùng lấy dòng dưới như thế này !


Em tự viết như thế này. mà nó cứ lấy dòng trên cùng. Vậy phải sửa làm sao để lấy dòng dưới cùng

Sub LocTrung()
Range("H5:K21").ClearContents ' output xoa truoc truoc
Dim i As Long, k As Long, t As Long
Dim sArr(), dArr()
Dim Dic As Object
Set Dic = CreateObject("Scripting.dictionary")
sArr = Range("C5:f50000").Value ' du lieu dau vao
ReDim dArr(1 To UBound(sArr), 1 To 4)
For i = 1 To UBound(sArr)
    If Not Dic.exists(sArr(i, 1)) Then
        k = k + 1
        Dic(sArr(i, 1)) = k
        dArr(k, 1) = sArr(i, 1)
        dArr(k, 2) = sArr(i, 2)
        dArr(k, 3) = sArr(i, 3)
        dArr(k, 4) = sArr(i, 4)
    End If
Next
[H5].Resize(k, 4) = dArr  ' Ouput
Set Dic = Nothing
End Sub

Xin chân thành cảm ơn 1

 

[PacificPR]

Thf nhà họ viết như thế này thử

Sub LocTrung()
Range("H5:K21").ClearContents ' output xoa truoc truoc
    Dim I As Long, K As Long, J  As Long
    Dim sArr(), dArr()
    Dim Dic As Object, v As Variant
Set Dic = CreateObject("Scripting.dictionary")
sArr = Range("C5:f50000").Value ' du lieu dau vao
ReDim dArr(1 To UBound(sArr), 1 To 4)
For I = 1 To UBound(sArr)
    Dic.Item(sArr(I, 1)) = I
Next
For Each v In Dic.Items
    K = K + 1
    For J = 1 To UBound(sArr, 2)
        dArr(K, J) = sArr(v, J)
    Next J
Next
[H5].Resize(K, 4) = dArr  ' Ouput
Set Dic = Nothing
End Sub

 

[Phuocam]

Sửa dòng:

For i = 1 To UBound(sArr)

Thành:
For i = UBound(sArr) To 1 Step -1

Hoặc chỉ cần Advanced Filter

 

[vanthinh3101]

Sửa dòng:

Thành:
For i = UBound(sArr) To 1 Step -1

Hoặc chỉ cần Advanced Filter

em chưa rành Advanced Filter cho trường hợp này, anh chỉ rõ hơn được không ạ?

 

[minhtuan55]

Thf nhà họ viết như thế này thử

Sub LocTrung()
Range("H5:K21").ClearContents ' output xoa truoc truoc
    Dim I As Long, K As Long, J  As Long
    Dim sArr(), dArr()
    Dim Dic As Object, v As Variant
Set Dic = CreateObject("Scripting.dictionary")
sArr = Range("C5:f50000").Value ' du lieu dau vao
ReDim dArr(1 To UBound(sArr), 1 To 4)
For I = 1 To UBound(sArr)
    Dic.Item(sArr(I, 1)) = I
Next
For Each v In Dic.Items
    K = K + 1
    For J = 1 To UBound(sArr, 2)
        dArr(K, J) = sArr(v, J)
    Next J
Next
[H5].Resize(K, 4) = dArr  ' Ouput
Set Dic = Nothing
End Sub

Cảm ơn anh. Cho em hỏi chổ
For J = 1 To UBound(sArr, 2) Số 2 này nghỉa là gì anh. Ví dụ Bảng tính gồm 10 cột thì vẫn để số 2 hay là số nào anh

Bài đã được tự động gộp: 6/1/19

Sửa dòng:

Thành:
For i = UBound(sArr) To 1 Step -1

Hoặc chỉ cần Advanced Filter

Advanced Filter vẫn được nhưng sẽ rất chậm

 

[KimChi_Tran]

Không được chiên nghiệp như anh PacificPR, em cũng xin đưa ra 1 phương án hơi củ chuối ạ.

Sub LocTrung()
Range("H5:K21").ClearContents ' output xoa truoc truoc
    Dim i As Long, k As Long, v As Long, j As Long
    Dim sArr(), dArr()
    Dim Dic As Object
Set Dic = CreateObject("Scripting.dictionary")
sArr = Range("C5:F25").Value ' du lieu dau vao tang them 1 dong
ReDim dArr(1 To UBound(sArr), 1 To 4)
For i = 1 To (UBound(sArr))
    If Not Dic.exists(sArr(i, 1)) Then
    Dic.Add (sArr(i, 1)), i - 1
        v = Dic.Item(sArr(i, 1))
        If v > 0 Then
        k = k + 1
            For j = 1 To UBound(sArr, 2)
                dArr(k, j) = sArr(v, j)
            Next
        End If
    End If
Next
[H5].Resize(k, 4) = dArr  ' Ouput
Set Dic = Nothing
End Sub

 

[Hoàng Nhật Phương]

Cảm ơn anh. Cho em hỏi chổ
For J = 1 To UBound(sArr, 2) Số 2 này nghỉa là gì anh. Ví dụ Bảng tính gồm 10 cột thì vẫn để số 2 hay là số nào anh

Theo OT hiểu, số 2 này nghĩa là duyệt mảng sArr :

sArr = Range("C5:f50000").Value

từ trái sang phải bắt đầu từ cột C đến cột F, để xác định kích thước chiều thứ 2 của mảng:

UBound(sArr, 2) = 4

C=1,D=2,E=3,F=4
nếu bảng tính gồm 10 cột thì vẫn để số 2. và thay đổi:
vùng: Range("C5:f50000")
và số: 4 = số cột tính từ cột đầu tiên (C) đến cột cuối.

 

[PacificPR]

Em ngịch tẹo với công thức mang vào VBA.

Sub Thu_ty_thoi()
    Dim sArr, dArr, Rng As Range, a As Long, b As Long
    Dim Arr(), N As Long
    Set Rng = Range("C5", Range("C" & Rows.Count).End(xlUp))
    sArr = Range("C5", Range("C" & Rows.Count).End(xlUp)).Resize(, 4).Value
    For I = 1 To UBound(sArr)
        a = Application.CountIf(Rng, sArr(I, 1))
        b = Application.CountIf(Rng(1, 1).Resize(I), sArr(I, 1))
        If a = b Then
            N = N + 1
            ReDim Preserve Arr(1 To N)
            Arr(N) = I
        End If
    Next I
    dArr = Application.Index(sArr, Application.Transpose(Arr), Array(1, 2, 3, 4))
    
    Range("H5").Resize(UBound(dArr, 1), UBound(dArr, 2)) = dArr
End Sub

 

[KimChi_Tran]

Anh @PacificPR cho em hỏi chút ạ. Khi mình viết như thế này :
Dic.Item(sArr(I, 1)) = I
Khác gì với việc em viết :
IF not dic.exists.....
Dic.Add (Key), Item
Anh có thể giải thích giúp em qua về thuật toán của anh ở bài trên không ạ? Em đoán là ở chỗ For each v in Dic.items nhưng em k hiểu tại sao chỗ Dic.items có thể chỉ ra vị trí lặp lần cuối cùng của Keys. Em ngâm cứu cả buổi chiều mà vẫn chưa hiểu ra vì sao.
Em cảm ơn anh nhiều ạ.

 

[PacificPR]

Anh @PacificPR cho em hỏi chút ạ. Khi mình viết như thế này :
Dic.Item(sArr(I, 1)) = I
Khác gì với việc em viết :
IF not dic.exists.....
Dic.Add (Key), Item
Anh có thể giải thích giúp em qua về thuật toán của anh ở bài trên không ạ? Em đoán là ở chỗ For each v in Dic.items nhưng em k hiểu tại sao chỗ Dic.items có thể chỉ ra vị trí cuối cùng của Keys trong Dic. Em ngâm cứu cả buổi chiều mà vẫn chưa hiểu ra vì sao.
Em cảm ơn anh nhiều ạ.

Bạn sang đây đọc thì sẽ rõ thôi

 

[PacificPR]

@KimChi_Tran
Trong bài Tổng quan về Scripting.Dictionary có mục 3 các Anh ấy nói về cái này rồi mà
Cách của Bạn sai nếu dữ liệu không được sắp xếp theo tuần tự

 

[KimChi_Tran]

@KimChi_Tran
Trong bài Tổng quan về Scripting.Dictionary có mục 3 các Anh ấy nói về cái này rồi mà
Cách của Bạn sai nếu dữ liệu không được sắp xếp theo tuần tự

Em cảm ơn anh @PacificPR.
Em ý thức được là nếu dữ liệu không được sort thì code của em sẽ sai. Thế mới nói cách của em hơi củ chuối là như vậy ạ.
Vì dữ liệu của chủ topic có phần đặc biệt nên cách củ chuối của em mới có tác dụng.
Nếu em là chủ topic em sẽ xài công thức Lookup cho nó đỡ đau đầu ạ.

 

[be_09]

Copy dòng có Font chữ màu đỏ:

Sub Copy_MauDo()
    Dim WS As Worksheet
    Dim DongCuoi, i, RowBatDau As Long
    Set WS = ThisWorkbook.Worksheets("Sheet1")
  
    With WS
        'Tìm dòng cuói
        DongCuoi = .Cells(Rows.Count, 3).End(xlUp).Row
      
        If 5 > DongCuoi Then Exit Sub
        Sheet1.Range("H4").CurrentRegion.Offset(1).ClearContents
        RowBatDau = 5
        For i = 5 To DongCuoi
        'Chon Cell có màu Red
            If .Cells(i, 3).Font.ColorIndex = 3 Then
                Cells(i, 3).Resize(3, 6).Copy .Cells(RowBatDau, "H")
                RowBatDau = RowBatDau + 1
            End If
        Next i
    End With
    Set WS = Nothing
End Sub

 

[snow25]

Không được chiên nghiệp như anh PacificPR, em cũng xin đưa ra 1 phương án hơi củ chuối ạ.

Sub LocTrung()
Range("H5:K21").ClearContents ' output xoa truoc truoc
    Dim i As Long, k As Long, v As Long, j As Long
    Dim sArr(), dArr()
    Dim Dic As Object
Set Dic = CreateObject("Scripting.dictionary")
sArr = Range("C5:F25").Value ' du lieu dau vao tang them 1 dong
ReDim dArr(1 To UBound(sArr), 1 To 4)
For i = 1 To (UBound(sArr))
    If Not Dic.exists(sArr(i, 1)) Then
    Dic.Add (sArr(i, 1)), i - 1
        v = Dic.Item(sArr(i, 1))
        If v > 0 Then
        k = k + 1
            For j = 1 To UBound(sArr, 2)
                dArr(k, j) = sArr(v, j)
            Next
        End If
    End If
Next
[H5].Resize(k, 4) = dArr  ' Ouput
Set Dic = Nothing
End Sub

Sao bạn không dùng luôn else của dic là được mà.

 

[VetMini]

Code bài #2 không đạt với yêu cầu thớt đâu.
Trong đó, nó gọi hàm UBound() thừa Dic.Items.Count - 1 lần. Tức là bị chậm khoảng vài phần ngàn giây.

Code bài #2 đã không đạt thì các code khác ra rìa hết. Nhất là code bài #8, nếu thớt biết qua nguyên lý boundary test là nó rụng ngay. Mà dân giỏi Xê cọng cọng thì đương nhiên phải biết boundary test rồi.

Chú cho các bạn khác muốn tám thêm về code:
Phương án bài #3 không dùng được vì kết quả sẽ đảo nghịch thứ tự.
Bài #6 rắc rối không cần thiết.