Dùng dictionary để xoá range tương ứng với giá trị duy nhất được không ah? (1 người xem)

[Lequocvan]

A	B	C	D	E
1	l1c2	l1c3	l1c4	l1c5
2	l2c2	l2c3	l2c4	l2c5
1	a	b	c	e
5	01	412	8543	2198
8	102	731	4932

Dùng dictionary có thể làm được việc: Tìm ở cột A, khi thấy giá trị duy nhất thì xoá cả dòng hoặc xoá range tương ứng không ah?

 

[befaint]

Vậy kết quả không còn hai dòng có giá trị 1 ở cột A phải không?

 

[VetMini]

Tại sao lại phải hỏi? Tự thử có mất tiền đâu?
Khi nào không được thì lên hỏi tiếp.

 

[Lequocvan]

Vậy kết quả không còn hai dòng có giá trị 1 ở cột A phải không?

Ngược lại ah, tìm ở cột A thấy giá trị duy nhất thì xoá dòng đó ah.

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

Tại sao lại phải hỏi? Tự thử có mất tiền đâu?
Khi nào không được thì lên hỏi tiếp.

em thử các kiểu con đà điểu mà chưa ra, nên mới hỏi ah, mong được mọi người chỉ giúp

 

[VetMini]

...
em thử các kiểu con đà điểu mà chưa ra, nên mới hỏi ah, mong được mọi người chỉ giúp

Các kiểu gồm có những kiểu nào?
Từ đầu, bạn đòi hỏi đít sần. Có nghĩa là bạn muốn biết khả năng của đít sần, và không cần biết đến các giải pháp khác?

 

[Lequocvan]

Các kiểu gồm có những kiểu nào?
Từ đầu, bạn đòi hỏi đít sần. Có nghĩa là bạn muốn biết khả năng của đít sần, và không cần biết đến các giải pháp khác?

em loay hoay với dictionary rồi nhưng không ra kết quả được ah. Có lẽ tại em chưa nắm vững dictionary

 

[VetMini]

Nói tùm lum cả buổi ròi bạn vẫn chưa cho biết hai điều tối quan trộng:

1. xác định phải dùng đít sần, cách khác không được?

2. đưa hình lên cho biết nếu đít sần đít mụn gì đó thành công thì kết quả ra sao?

 

[Maika8008]

Bài này chạy lặp 2 vòng của dữ liệu có được không bà con nhỉ? Tạm thời tôi chỉ nghĩ được cách như vậy.

 

[Hoàng Tuấn 868]

Bài này chạy lặp 2 vòng của dữ liệu có được không bà con nhỉ? Tạm thời tôi chỉ nghĩ được cách như vậy.

Một vòng cũng đủ rồi anh.

 

[Maika8008]

Một vòng cũng đủ rồi anh.

Ờ nhỉ, 1 vòng dùng countA cũng được mà.

 

[Hoàng Tuấn 868]

Ờ nhỉ, 1 vòng dùng countA cũng được mà.

Dùng Countif cũng được anh à.

 

[Maika8008]

Dùng Countif cũng được anh à.

Chết mịa, cái đầu mình sáng nay lủng củng rồi. Countif chứ không phải countA.

Chủ thớt cứ theo gợi ý mà làm thì xong.

 

[bebo021999]

em loay hoay với dictionary rồi nhưng không ra kết quả được ah. Có lẽ tại em chưa nắm vững dictionary

Có thể xóa dễ dàng trên sheet. Nhưng vì bạn muốn tìm hiểu các dùng dic nên mình cũng mạn phép đưa ra hướng giải như sau:
Dùng 2 vòng lặp.
Đầu tiên nạp data vào mảng rng (để tăng tốc code)

rng = Range("A1:E" & Cells(Rows.Count, "A").End(xlUp).Row).Value

Vòng lặp 1: Duyệt qua cột A, nếu xuất hiện lần đầu tiên thì nạp item cho nó là số thứ tự dòng, từ lần 2 thì nạp "x" (hoặc ký tự bất kỳ)

For i = 1 To UBound(rng)
    If Not dic.exists(rng(i, 1)) Then
        dic.Add rng(i, 1), i
    Else
        dic(rng(i, 1)) = "x"
    End If
Next

Khi vòng lặp kết thúc thì dic đã được nạp xong, các key của nó có 2 loại item: là số (nếu duy nhất) hoặc là ký tự "x" (nếu lặp 2 lần trở lên)

Vòng lặp 2: Duyệt qua key của dic, kiểm tra item có phải là số hay không. Nếu là số thì xóa dòng tương ứng.

For Each key In dic.keys
    If IsNumeric(dic(key)) Then Cells(dic(key), 1).Interior.Color = vbYellow
Next

Ở đây tôi test trước bằng cách tô màu cho cell để bạn dễ dàng kiểm tra. Sau đó muốn xóa cell, range hay cả dòng thì tùy ý
VD: Xóa range:

If IsNumeric(dic(key)) Then Cells(dic(key), 1).Resize(1, 5).ClearContents

 

[befaint]

Bài trên làm sai rồi.

Với hình bài #1 thì sau khi xóa sẽ còn hai dòng có giá trị 1.

 

[bebo021999]

Bài trên làm sai rồi.
Với hình bài #1 thì sau khi xóa sẽ còn hai dòng có giá trị 1.

Có lẽ bác nhầm chăng?
Sau khi chạy code thì các ô duy nhất sẽ được tô màu (để test, Sau đó delete range hay dòng thì tùy chủ thớt.)

 

[befaint]

Có lẽ bác nhầm chăng?

Đấy là lời của chủ thớt nhé bác.

 

[bebo021999]

Đấy là lời của chủ thớt nhé bác.

Em thấy chủ thớt nói có gì mâu thuẫn đâu nhỉ?
"Thấy giá trị duy nhất thì xóa", nghĩa là số 1 (xuất hiện 2 lần, không phải duy nhất) sẽ được giữ lại
Sau đó bác hỏi nghĩa là số 1 sẽ bị xóa?
Thì thớt phủ định, nghĩa là số 1 không bị xóa.

 

[snow25]

Dùng Countif cũng được anh à.

Tại sao lại dùng hàm Countif để thay cho vòng lặp dữ liệu nó lớn tầm 100k dòng biết bao giờ mới xong.

 

[Hoàng Tuấn 868]

Tại sao lại dùng hàm Countif để thay cho vòng lặp dữ liệu nó lớn tầm 100k dòng biết bao giờ mới xong.

Thông thường với dữ liệu ngần ấy dòng thì chủ bài thông báo điều đó ngay từ đầu rồi anh.

 

[bebo021999]

Thông thường với dữ liệu ngần ấy dòng thì chủ bài thông báo điều đó ngay từ đầu rồi anh.

Mình có thói quen khi giải bài là mặc định làm việc với data lớn.
Nếu dùng COUNTIF thì phải dùng cột phụ?
Trường hợp này là chủ thớt muốn thực tập dùng dictionary thôi.

 

[Maika8008]

Mình có thói quen khi giải bài là mặc định làm việc với data lớn.
Nếu dùng COUNTIF thì phải dùng cột phụ?
Trường hợp này là chủ thớt muốn thực tập dùng dictionary thôi.

Dùng WorksheetFunction.Countif() = 1 là điều kiện để add range cần xóa chứ không phải tạo cột phụ bạn à.

 

[snow25]

Dùng Countif cũng được anh à.

Không dùng hàm chỉ dùng thuật toán vẫn chạy được 1 vòng lặp với bài này.Nhưng có khả năng kết quả không theo thứ tự.

 

[Hoàng Tuấn 868]

Không dùng hàm chỉ dùng thuật toán vẫn chạy được 1 vòng lặp với bài này.

Anh cho ví dụ để các thành viên học hỏi thêm anh nhé.

 

[bebo021999]

Không dùng hàm chỉ dùng thuật toán vẫn chạy được 1 vòng lặp với bài này.Nhưng có khả năng kết quả không theo thứ tự.

Nếu cột A là giá trị.
Không dùng cột phụ, đồng thời không dùng vòng lặp, code này tốc độ có lẽ tương đương dùng dic:
Thứ tự không đổi. Chỉ có vấn đề là nếu cột A là công thức thì sẽ bị mất

Option Explicit
Sub delete()
Dim rng As String
rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Address
With Range(rng)
    .Value = Evaluate("=" & rng & "/(INDEX(COUNTIF(" & rng & "," & rng & "),)>1)")
    .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.delete
End With
End Sub

 

[VetMini]

Bài trên làm sai rồi.

Với hình bài #1 thì sau khi xóa sẽ còn hai dòng có giá trị 1.

View attachment 287374

Đó chỉ là lý luận của bạn thôi.
Hiện tại thớt chưa xác định lô gic từ đầu vào đi qua đầu ra thì mọi nhận xét đúng/sai chỉ là võ đoán.
Lắm lúc, sửa soạn xong ví dụ đầu raddaangwopwif hỏi mới nhận ra vài điểm phi lý trong chính yêu cầu của mình.

 

[bebo021999]

lô gic từ đầu vào đi qua đầu ra

Hic, cách bác dùng rất là ấn tượng về mặt hình ảnh trong bộ môn giải phẫu học, có thể hình dung được cái logic biến đổi thế nào sau chu trình này.

 

[VetMini]

Hic, cách bác dùng rất là ấn tượng về mặt hình ảnh trong bộ môn giải phẫu học, có thể hình dung được cái logic biến đổi thế nào sau chu trình này.

Bạn có học qua ngành Y?

 

[ptm0412]

Nếu cột A là giá trị.
Không dùng cột phụ, đồng thời không dùng vòng lặp, code này tốc độ có lẽ tương đương dùng dic:
Thứ tự không đổi. Chỉ có vấn đề là nếu cột A là công thức thì sẽ bị mất

Chân chất Dict 2 vòng lặp.

Sub XoaDuyNhat()
Dim LastR As Long, Arr(), Dict1, Dict2
LastR = Sheet1.Cells(10000, 1).End(xlUp).Row
Set Dict1 = CreateObject("Scripting.Dictionary")
Set Dict2 = CreateObject("Scripting.Dictionary")
Arr = Sheet1.Range("A2:A" & LastR).Value
For i = 1 To UBound(Arr, 1)
    If Dict1.exists(Arr(i, 1)) Then
        Dict1.Remove Arr(i, 1)
        Dict2.Add Arr(i, 1), i
    Else
        If Not Dict2.exists(Arr(i, 1)) Then Dict1.Add Arr(i, 1), i
    End If
Next
For i = LastR To 2 Step -1
    If Dict2.exists(Sheet1.Cells(i, 1).Value) Then
        Sheet1.Cells(i, 1).EntireRow.Delete
    End If
Next
End Sub

Code này viết chơi cho vui, chứ chủ bài đăng có đọc bài nhưng nhất định không trả lời việc làm mẫu đầu ra. Ít nhất cũng nói sau khi xóa còn 2, 5, 8 hay là sau khi xóa còn 2 số 1.
Code này trị cả 2, chỉ cần thêm bớt 1 chữ hoặc sửa 1 ký tự.

 

[ptm0412]

Với dữ liệu 10,000 dòng, 10 cột,

Nếu cột A là giá trị.
code này tốc độ có lẽ tương đương dùng dic:

Dict này nhanh gấp từ 80 đến 90 lần code bebo. Test với 10 ngàn dòng và 10 cột

Sub XoaDuyNhat()
Dim LastR As Long, Arr(), Dict1, Dict2, ResArr(), k As Long
LastR = Sheet1.Cells(100000, 1).End(xlUp).Row
Set Dict1 = CreateObject("Scripting.Dictionary")
Set Dict2 = CreateObject("Scripting.Dictionary")
Arr = Sheet1.Range("A2:j" & LastR).Value
ReDim ResArr(1 To UBound(Arr, 1), 1 To 10)
t = Timer
For i = 1 To UBound(Arr, 1)
    If Dict1.exists(Arr(i, 1)) Then
        Dict1.Remove Arr(i, 1)
        Dict2.Item(Arr(i, 1)) = i
    Else
        If Not Dict2.exists(Arr(i, 1)) Then Dict1.Add Arr(i, 1), i
    End If
Next
For i = 1 To UBound(Arr, 1)
    If Dict2.exists(Arr(i, 1)) Then
        k = k + 1
        For j = 1 To 10
            ResArr(k, j) = Arr(i, j)
        Next j
    End If
Next
If k > 0 Then
    Sheet1.Range("A2:j" & LastR).Clear
    Sheet1.Range("A2").Resize(k, 10).Value = ResArr
End If
Set Dict1 = Nothing: Set Dict2 = Nothing
Sheet1.Cells(1, 12) = Timer - t
End Sub

 

[tranhungdao12a3]

Bạn có dùng R hoặc Python không, tôi viết cho bạn, VBA thì tôi không biết!

 

[befaint]

Sheet1.Range("A2:j" & LastR).Clear

Dùng .Clear sẽ làm bảng tính phình dung lượng to đùng.
Vụ này em có đề cập một lần lâu rồi, và hầu như không ai biết.

 

[ptm0412]

Dùng .Clear sẽ làm bảng tính phình dung lượng to đùng.
Vụ này em có đề cập một lần lâu rồi, và hầu như không ai biết.

Có điều chắc chắn là Clear còn đỡ hơn ClearContents.

 

[befaint]

Có điều chắc chắn là Clear còn đỡ hơn ClearContents.

Ngược lại anh nhé.

Anh cứ thử nghiệm các kiểu đi sẽ thấy.

 

[Ronaldinho7]

Ngược lại anh nhé.

Anh cứ thử nghiệm các kiểu đi sẽ thấy.

.ClearContents với =“” thì sao anh?

 

[HieuCD]

A	B	C	D	E
1	l1c2	l1c3	l1c4	l1c5
2	l2c2	l2c3	l2c4	l2c5
1	a	b	c	e
5	01	412	8543	2198
8	102	731	4932

Dùng dictionary có thể làm được việc: Tìm ở cột A, khi thấy giá trị duy nhất thì xoá cả dòng hoặc xoá range tương ứng không ah?

Dùng mảng gán kết quả đồng thời xóa dữ liệu

Sub ABC()
  Dim arr(), res(), Dic As Object, sRow&, sCol&, i&, k&, ik&, j&, key$
 
  Set Dic = CreateObject("Scripting.Dictionary")
  arr = Range("A2:E" & Range("A" & Rows.Count).End(xlUp).Row).Value
  sRow = UBound(arr): sCol = UBound(arr, 2)
  ReDim res(1 To sRow, 1 To sCol)

  For i = 1 To sRow
    If Not Dic.exists(arr(i, 1)) Then
      Dic.Add arr(i, 1), i
    Else
      key = "|" & arr(i, 1)
      If Not Dic.exists(key) Then
        Dic.Add key, Empty
        ik = Dic(arr(i, 1))
        k = k + 1
        For j = 1 To sCol
          res(k, j) = arr(ik, j)
        Next j
      End If
      k = k + 1
      For j = 1 To sCol
        res(k, j) = arr(i, j)
      Next j
    End If
  Next
  Range("A2").Resize(sRow, sCol) = res
End Sub

 

[ptm0412]

Vẫn là phong cách dùng 1 Dict cho nhiều loại key.

Ngược lại anh nhé.

Mình thì hiểu đơn giản là Clear bao gồm xóa dữ liệu và xóa cả định dạng. ClearContents chỉ xóa dữ liệu, để lại định dạng. Chính định dạng không dữ liệu mới làm nặng file.

 

[befaint]

Mình thì hiểu đơn giản là Clear bao gồm xóa dữ liệu và xóa cả định dạng. ClearContents chỉ xóa dữ liệu, để lại định dạng. Chính định dạng không dữ liệu mới làm nặng file

Clear để lại "vết" trên Cells. Đó là một trong các nguyên nhân file nặng mấy trăm MB mặc dù không có dữ liệu.
Anh cần làm thật mới thấy. Khi cái last row của anh càng lớn thì càng rõ rệt.
ClearContents không xảy ra hiện tượng trên.
Mà thôi kệ anh.

 

[ptm0412]

Mà thôi kệ anh.

Thật ra khi làm thật, kết quả là dữ liệu qua chỉnh sửa, mình sẽ dùng ClearContents để khỏi mất công định dạng lại, nhất là ngày tháng. Số thì kệ nó. Khung thì không có.
Trừ khi làm ra báo cáo thì phải Clear, trường hợp số dòng kết quả thay đổi. Nếu ít hơn lần trước, sinh ra định dạng thừa, nếu nhiều hơn thì định dạng thiếu. (nhất là đóng khung).