Bỏ trùng bằng Dictionary

Sói1102 · 19/6/23

Chào mọi người ạ!
Mình sử dụng code VBA ở dưới để xóa bỏ "Code" nếu trùng ở cột G nhưng không đuợc
Mọi người sửa lại giúp mình với ạ!

Mã:

Sub Test()

Dim i&, LastR&, c&, r&, sArr, Arr, j&

Dim Dic As Object

Set Dic = CreateObject("Scripting.Dictionary")

LastR = Range("A" & Rows.Count).End(xlUp).Row

sArr = Range("A2:D" & LastR).Value

For i = 2 To Range("G" & Rows.Count).End(xlUp).Row

    If Not Dic.Exists(Cells(i, "G")) Then

        Dic.Add Cells(i, "G"), i

    End If

Next

ReDim Arr(1 To UBound(sArr, 1), 1 To UBound(sArr, 2))

For c = 1 To UBound(sArr, 1)

    If Not Dic.Exists(sArr(c, 3)) Then

        r = r + 1

        For j = 1 To UBound(sArr, 2)

            Arr(r, j) = sArr(c, j)

        Next

    End If

Next

Range("A2").Resize(LastR, 4).ClearContents

Range("A2").Resize(r, 4).Value = Arr

'Range("I1").Resize(Dic.Count).Value = WorksheetFunction.Transpose(Dic.Keys)

End Sub

BuiQuangThuan · 19/6/23

Sói1102 đã viết:
Mình sử dụng code ở dưới để xóa bỏ code nếu trùng ở cột H nhưng không đuợc
Mọi người sửa lại giúp mình với ạ!

Xóa bỏ trùng với lọc trùng. bạn đang muốn như nào?
Kết quả mẫu thử coi

Sói1102 · 19/6/23

BuiQuangThuan đã viết:
Xóa bỏ trùng với lọc trùng. bạn đang muốn như nào?
Kết quả mẫu thử coi

Xóa bỏ bạn ạ,mong muốn mình để ở ảnh với file rồi đấy ạ

BuiQuangThuan · 19/6/23

Sói1102 đã viết:
Xóa bỏ bạn ạ,mong muốn mình để ở ảnh với file rồi đấy ạ

sao mã này không tính là trùng vậy

Hoàng Tuấn 868 · 19/6/23

Sói1102 đã viết:
Mình sử dụng code ở dưới để xóa bỏ code

Vụ này thì hơi khó nhỉ.

Sói1102 · 19/6/23

BuiQuangThuan đã viết:
View attachment 291610
sao mã này không tính là trùng vậy

Mã đấy không có trong cột G nên không tính là trùng nhé

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

Hoàng Tuấn 868 đã viết:
Vụ này thì hơi khó nhỉ.

code VBA ở dưới để xóa bỏ "Code" nếu trùng ở cột G

))

Hoàng Tuấn 868 · 19/6/23

Sói1102 đã viết:
code VBA ở dưới để xóa bỏ "Code" nếu trùng ở cột G ))

À, thì ra là vậy.

BuiQuangThuan · 19/6/23

Sói1102 đã viết:
Mã đấy không có trong cột G nên không tính là trùng nhé

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

code VBA ở dưới để xóa bỏ "Code" nếu trùng ở cột G ))

Thử code này xem sao:

Mã:

Sub ABC()
    Dim Dic As Object, sArr(), Res(), i&, k&, j&
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheets("Sheet1")
        sArr = .Range("G2:G" & .Range("G" & Rows.Count).End(3).Row).Value
        For i = 1 To UBound(sArr)
            If Dic.exists(sArr(i, 1)) = False Then
                Dic.Add (sArr(i, 1)), ""
            End If
        Next
        sArr = .Range("A2:D" & .Range("B" & Rows.Count).End(3).Row).Value
        ReDim Res(1 To UBound(sArr), 1 To 4)
        For i = 1 To UBound(sArr)
            If Dic.exists(sArr(i, 3)) = True Then
                k = k + 1
                For j = 1 To UBound(sArr, 2)
                    Res(k, j) = sArr(i, j)
                Next
            End If
        Next
        If k Then
            .Range("K2").Resize(10000, 4).ClearContents
            .Range("K2").Resize(k, 4).Value = Res
        End If
    End With
End Sub

Sói1102 · 19/6/23

BuiQuangThuan đã viết:

Thử code này xem sao:

Mã:

Sub ABC()
    Dim Dic As Object, sArr(), Res(), i&, k&, j&
    Set Dic = CreateObject("Scripting.Dictionary")
    With Sheets("Sheet1")
        sArr = .Range("G2:G" & .Range("G" & Rows.Count).End(3).Row).Value
        For i = 1 To UBound(sArr)
            If Dic.exists(sArr(i, 1)) = False Then
                Dic.Add (sArr(i, 1)), ""
            End If
        Next
        sArr = .Range("A2:D" & .Range("B" & Rows.Count).End(3).Row).Value
        ReDim Res(1 To UBound(sArr), 1 To 4)
        For i = 1 To UBound(sArr)
            If Dic.exists(sArr(i, 3)) = True Then
                k = k + 1
                For j = 1 To UBound(sArr, 2)
                    Res(k, j) = sArr(i, j)
                Next
            End If
        Next
        If k Then
            .Range("K2").Resize(10000, 4).ClearContents
            .Range("K2").Resize(k, 4).Value = Res
        End If
    End With
End Sub

Cảm ơn bạn nhé,code đúng với nhu cầu của mình rồi
Mà code của mình gần giống với bạn nhưng không chạy được.Bạn giải thích giúp được không nhỉ?

BuiQuangThuan · 19/6/23

Sói1102 đã viết:
Cảm ơn bạn nhé,code đúng với nhu cầu của mình rồi
Mà code của mình gần giống với bạn nhưng không chạy được.Bạn giải thích giúp được không nhỉ?

Thêm phần khoanh đỏ. . .

Maika8008 · 19/6/23

Sói1102 đã viết:

Chào mọi người ạ!
Mình sử dụng code VBA ở dưới để xóa bỏ "Code" nếu trùng ở cột G nhưng không đuợc
Mọi người sửa lại giúp mình với ạ!
View attachment 291609

Mã:

Sub Test()

Dim i&, LastR&, c&, r&, sArr, Arr, j&

Dim Dic As Object

Set Dic = CreateObject("Scripting.Dictionary")

LastR = Range("A" & Rows.Count).End(xlUp).Row

sArr = Range("A2:D" & LastR).Value

For i = 2 To Range("G" & Rows.Count).End(xlUp).Row

    If Not Dic.Exists(Cells(i, "G")) Then

        Dic.Add Cells(i, "G"), i

    End If

Next

ReDim Arr(1 To UBound(sArr, 1), 1 To UBound(sArr, 2))

For c = 1 To UBound(sArr, 1)

    If Not Dic.Exists(sArr(c, 3)) Then

        r = r + 1

        For j = 1 To UBound(sArr, 2)

            Arr(r, j) = sArr(c, j)

        Next

    End If

Next

Range("A2").Resize(LastR, 4).ClearContents

Range("A2").Resize(r, 4).Value = Arr

'Range("I1").Resize(Dic.Count).Value = WorksheetFunction.Transpose(Dic.Keys)

End Sub

Hỏi:
1. Có phải là tại cột G có mã số nào thì cột C không lấy mã số ấy?
2. Kết quả chép vào đâu? Tại sao lại thấy dòng lệnh dán vào A2 vậy?

Sói1102 · 19/6/23

Maika8008 đã viết:
Hỏi:
1. Có phải là tại cột G có mã số nào thì cột C không lấy mã số ấy?
2. Kết quả chép vào đâu? Tại sao lại thấy dòng lệnh dán vào A2 vậy?

1.Đúng rồi anh
2.Kết quả dán vào A2 luôn
Code mình chạy được rồi nhé,thêm .Value là ổn rồi ạ

Maika8008 · 19/6/23

Sói1102 đã viết:
1.Đúng rồi anh
2.Kết quả dán vào A2 luôn
Code mình chạy được rồi nhé,thêm .Value là ổn rồi ạ

Tôi thấy trên điện thoại chưa có bài #8 nên mới hỏi. Lạ thay, khi vào trên máy tính thì hóa ra bài toán đã có đáp án, thành ra câu hỏi trở nên thừa thãi.

VetMini · 19/6/23

Công nhận đít sần cọng Vê Bê A có mãnh lực ghê.

Mình nhìn bài toán chỉ thấy công thức tính trùng và advanced filter. Hủ lậu thật.

Phuocam · 20/6/23

.

Chỉ cần dùng advanced filter với điều kiện lọc là =COUNTIF($G$2:$G$5,C2)=0

.

Maika8008 · 20/6/23

Advanced Filter là công cụ tuyệt vời nhưng lại ít người dùng hoặc ít khi dùng nên không phải ai cũng (nhất thời) nghĩ ra được những công dụng của nó để mà dùng. Ví dụ đâu phải ai cũng biết thay vì dùng Dictionary lằng nhằng thì dùng Advanced Filter cũng lấy ra được 1 danh sách duy nhất. Do vậy, "đít sần cọng Vê Bê A có mãnh lực" chưa hẳn đã đúng.

bebo021999 · 20/6/23

Trong trường hợp này dùng dictionary là dùng "dao mổ trâu giết gà"
Nếu cần phải trích xuất giá trị trùng, hay giá trị duy nhất thì dùng dictionary là hợp lý.
Còn nếu dùng dic chỉ để kiểm tra trùng thì dùng Countif là đủ rồi.

PHP:

Sub Test()
Dim i&, j&, LastR&, sArr, Arr(1 To 10000, 1 To 4)
LastR = Range("A" & Rows.Count).End(xlUp).Row
sArr = Range("A2:D" & LastR).Value
LastR = Range("G" & Rows.Count).End(xlUp).Row
For i = 1 To UBound(sArr)
    If WorksheetFunction.CountIf(Range("G2:G" & LastR), sArr(i, 3)) Then ' Nếu trùng thì không làm gì cả
    Else ' Nếu trùng thì copy dòng đó vào Arr
        k = k + 1
        For j = 1 To 4
            Arr(k, j) = sArr(i, j)
        Next
    End If
Next
If k Then
    Range("A2:D100000").ClearContents
    Range("A2").Resize(k, 4).Value = Arr
End If
End Sub

tranhungdao12a3 · 20/6/23

Lọc tính tổng giá trị ngoài Table2:

Văn Toàn 1996 · 20/6/23

Sói1102 đã viết:

Chào mọi người ạ!
Mình sử dụng code VBA ở dưới để xóa bỏ "Code" nếu trùng ở cột G nhưng không đuợc
Mọi người sửa lại giúp mình với ạ!
View attachment 291609

Mã:

Sub Test()

Dim i&, LastR&, c&, r&, sArr, Arr, j&

Dim Dic As Object

Set Dic = CreateObject("Scripting.Dictionary")

LastR = Range("A" & Rows.Count).End(xlUp).Row

sArr = Range("A2:D" & LastR).Value

For i = 2 To Range("G" & Rows.Count).End(xlUp).Row

    If Not Dic.Exists(Cells(i, "G")) Then

        Dic.Add Cells(i, "G"), i

    End If

Next

ReDim Arr(1 To UBound(sArr, 1), 1 To UBound(sArr, 2))

For c = 1 To UBound(sArr, 1)

    If Not Dic.Exists(sArr(c, 3)) Then

        r = r + 1

        For j = 1 To UBound(sArr, 2)

            Arr(r, j) = sArr(c, j)

        Next

    End If

Next

Range("A2").Resize(LastR, 4).ClearContents

Range("A2").Resize(r, 4).Value = Arr

'Range("I1").Resize(Dic.Count).Value = WorksheetFunction.Transpose(Dic.Keys)

End Sub

bạn thử lưỡi lam này xem

Mã:

Sub daolam()
On Error Resume Next
Range("E2:E23") = "=COUNTIF(R2C7:R23C7,RC[-2])"
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Col As Long
sArr = Range("A2:E1000").Value
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 5)
For I = 1 To R
    If sArr(I, 5) = 0 Then
        K = K + 1
        For Col = 1 To 5
            dArr(K, Col) = sArr(I, Col)
        Next Col
    End If
Next I
Range("K2:N1000,E2:E23").ClearContents
Range("K2").Resize(K, 4) = dArr
End Sub

VetMini · 20/6/23

Maika8008 đã viết:
Advanced Filter là công cụ tuyệt vời nhưng lại ít người dùng hoặc ít khi dùng nên không phải ai cũng (nhất thời) nghĩ ra được những công dụng của nó để mà dùng. Ví dụ đâu phải ai cũng biết thay vì dùng Dictionary lằng nhằng thì dùng Advanced Filter cũng lấy ra được 1 danh sách duy nhất. Do vậy, "đít sần cọng Vê Bê A có mãnh lực" chưa hẳn đã đúng.

Chắc chắn đúng.
Dân GPE có thói "lười biếng làm việc thủ công", và vì họ khá thành công với VBA (tự viết hay nhờ không quan trọng) cho nên họ không tự thấy nhu cầu học hỏi thêm cái khác.

Bỏ trùng bằng Dictionary

Thành viên mới

File đính kèm

❆❆❆❆❆❆❆❆❆❆❆❆

Thành viên mới

❆❆❆❆❆❆❆❆❆❆❆❆

Đăng ký hôm qua

Thành viên mới

Đăng ký hôm qua

❆❆❆❆❆❆❆❆❆❆❆❆

Thành viên mới

❆❆❆❆❆❆❆❆❆❆❆❆

Thành viên gạo cội

Thành viên mới

Thành viên gạo cội

Ăn cùng góc phố

Thành viên mới

Thành viên gạo cội

Thành viên gạo cội

Thành viên tiêu biểu

Thành viên hoạt động

Ăn cùng góc phố