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

[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?

 

[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).