Hỏi về code xóa dũ liệu trùng có điều kiện (1 người xem)
- Thread starter dtuntanh
- Ngày gửi
Người dùng đang xem chủ đề này
- Tham gia
- 19/12/10
- Bài viết
- 2,587
- Được thích
- 5,774
- Nghề nghiệp
- Công nhân vệ sinh số liệu
Cách 1...củ chuối đây, hihihi...xem file đính kèm nhé.
Upvote
0
Cảm on bạn, nhung bạn gủi lại cho mình Film vói, film trên bạn gủi bị lỗi ko mỏ dduocj.
Upvote
0
Let'GâuGâu
Thành viên mới
- Tham gia
- 12/9/13
- Bài viết
- 3,131
- Được thích
- 2,732
file của Hoamattroi tải về bìng thường mà?
góp thêm bạn đoạn code
Mã:
Sub demso()
Dim arr, Darr As Variant, d As Object, i, j As Long
[e2:e60000].Clear
arr = [a2].Resize([a60000].End(3).Row, 2).Value
Darr = [d2].Resize([d60000].End(3).Row - 1, 2)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Darr)
For j = 1 To UBound(arr)
If arr(j, 1) = Darr(i, 1) Then
If Not d.exists(arr(j, 1) & arr(j, 2)) Then
d.Add arr(j, 1) & arr(j, 2), ""
Darr(i, 2) = Darr(i, 2) + 1
End If
End If
Next j
Next i
[d2].Resize([d60000].End(3).Row - 1, 2) = Darr
End Sub
Upvote
0
Let'GâuGâu
Thành viên mới
- Tham gia
- 12/9/13
- Bài viết
- 3,131
- Được thích
- 2,732
code này chạy ở sheet2
Mã:
Sub demso()
Dim arr, Darr As Variant, d As Object, i, j As Long
[b2:b60000].Clear
arr = Sheet1.[a2].Resize(Sheet1.[a60000].End(3).Row, 2).Value
Darr = [a2].Resize([a60000].End(3).Row - 1, 2)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(Darr)
For j = 1 To UBound(arr)
If arr(j, 1) = Darr(i, 1) Then
If Not d.exists(arr(j, 1) & arr(j, 2)) Then
d.Add arr(j, 1) & arr(j, 2), ""
Darr(i, 2) = Darr(i, 2) + 1
End If
End If
Next j
Next i
[a2].Resize([a60000].End(3).Row - 1, 2) = Darr
End Sub
Upvote
0
- Tham gia
- 19/12/10
- Bài viết
- 2,587
- Được thích
- 5,774
- Nghề nghiệp
- Công nhân vệ sinh số liệu
Củ chuối 2, dùng UDF này thử xem sao, điều kiện và dữ liệu đặt ở sheet nào thì tùy bạn :
PHP:
Function Dem(Rng1 As Range, Rng2 As Range, dK As String)
Dim i As Long, k As Long, mArr As Variant
Dim sArr1(), sArr2()
Dim Dic As Object
Set Dic = CreateObject("Scripting.dictionary")
sArr1 = Rng1.Value
sArr2 = Rng2.Value
For i = 1 To UBound(sArr1)
mArr = sArr1(i, 1) & sArr2(i, 1)
If Not Dic.exists(mArr) Then
Dic.Add mArr, ""
If mArr Like "*" & dK & "*" Then
k = k + 1
End If
End If
Next
If dK <> "" Then Dem = k
Set Dic = Nothing
End Function
Lần chỉnh sửa cuối:
Upvote
0
Let'GâuGâu
Thành viên mới
- Tham gia
- 12/9/13
- Bài viết
- 3,131
- Được thích
- 2,732
Chỉnh lại code #6, tôi nghĩ là nó sẻ nhanh hơn
Mã:
Sub demso()
Dim arr, Darr As Variant, d As Object, i, j As Long
[b2:b60000].Clear
arr = Sheet1.[a2].Resize(Sheet1.[a60000].End(3).Row, 2).Value
Darr = [a2].Resize([a60000].End(3).Row - 1, 2)
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(arr)
If Not d.exists(arr(i, 1) & arr(i, 2)) Then
d.Add arr(i, 1) & arr(i, 2), arr(i, 1)
End If
Next
For j = 1 To UBound(Darr)
For Each Key In d
If d.Item(Key) = Darr(j, 1) Then Darr(j, 2) = Darr(j, 2) + 1
Next
Next j
[a2].Resize([a60000].End(3).Row - 1, 2) = Darr
End Sub
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,974
Công thức tại cell B2 của sheet2:
Mã:
=COUNT(1/FREQUENCY(IF(Sheet1!$A$2:$A$100=$A2,IF(Sheet1!$B$2:$B$100<>"",MATCH(Sheet1!$B$2:$B$100,Sheet1!$B$2:$B$100,0))),IF(Sheet1!$A$2:$A$100=$A2,IF(Sheet1!$B$2:$B$100<>"",MATCH(Sheet1!$B$2:$B$100,Sheet1!$B$2:$B$100,0)))))(Bài toán đếm duy nhất theo điều kiện có cả "đống" trên diễn đàn rồi)
Upvote
0
Anh ạ, dữ liệu của em gần 100.000 bản ghi, vậy khi dùng công thức như của anh có được ko ạ?
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,974
Ẹc... Ẹc... 100,000 dòng thì VBA chứ kéo công thức xong chắc phải đi ngủ, dậy, đánh răng xong chưa chắc anh Bill đã tính xong
Lần chỉnh sửa cuối:
Upvote
0
Một cách củ chuối nữa (không biết có to bằng mấy củ chuối trên không?)...
(chọn tools - reference - microsoft activex object 2.x)
Mã:
Sub GetData1()
Dim cnn As Connection, rst As Recordset, s$
On Error GoTo Loi
Set cnn = New Connection
s = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=""Excel 12.0;HDR=NO"";"
cnn.Open s
Set rst = New Recordset
s = "SELECT Q.SoLuot FROM KetQua K LEFT JOIN (SELECT HoTen,COUNT(*) AS SoLuot FROM (SELECT DISTINCT (F1 & F2),F1 AS Hoten FROM Data) GROUP BY HoTen) Q ON K.F1=Q.HoTen"
rst.Open s, cnn
Range("E2").CopyFromRecordset rst
Loi:
If rst.State = adStateOpen Then rst.Close
Set rst = Nothing
If cnn.State = adStateOpen Then cnn.Close
Set rst = Nothing
End Sub
Sub CreateName()
Dim r As Range, s$
Sheet1.Activate
Set r = Sheet1.Range("A2", Range("B1000000").End(xlUp))
s = "=" & r.Address
ThisWorkbook.Names.Add "Data", s
Set r = Range("D2", Range("D1000000").End(xlUp))
s = "=" & r.Address
ThisWorkbook.Names.Add "KetQua", s
End Sub
Sub DeleteName()
With ThisWorkbook
.Names("Data").Delete
.Names("KetQua").Delete
End With
End Sub
Sub Main()
CreateName
GetData1
DeleteName
End Sub
Lần chỉnh sửa cuối:
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,974
Tôi áng chừng với 100,000 dòng dữ liệu thì code 3 vòng lập này vẫn chạy.. hơi lâu
Gợi ý: Bạn có thể giảm xuống còn 2 vòng lập kết hợp với 2 dictionary, sẽ nhanh hơn nhiều đấy
Lưu ý thêm: Để lọc duy nhất 2 cột, khi bạn nối chuỗi lại với nhau (chỗ tôi đánh dấu màu đỏ), theo nguyên tắc "an toàn" bạn nên cho giữa chúng 1 ký tự đặc biệt nào đó, nếu không có thể dẫn đến sai lầm đáng tiếc
---------------------------
Các bạn khác thử nghiên cứu bài toán này xem (lưu ý rằng dữ liệu nhiều nên phải tối ưu hóa tốt một chút)
-----------------------------
Chẳng thấy chạy gì ráo! Cho file lên để minh họa đi bạn à!
Lần chỉnh sửa cuối:
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,974
Đã tải file ở bài 14, giả lập dữ liệu 100,000 dòng và chẳng thấy chạy gì ráo
Mời bạn thí nghiệm ADO với dữ liệu giả lập trong file đính kèm dưới đây xem ra kết quả trong bao lâu
Mời bạn thí nghiệm ADO với dữ liệu giả lập trong file đính kèm dưới đây xem ra kết quả trong bao lâu
Upvote
0
- Tham gia
- 5/6/08
- Bài viết
- 30,703
- Được thích
- 53,974
Cũng là một cách làm thôi! Có điều:
- ADO thích hợp đối với việc lấy dữ liệu trên file đóng
- Với file hiện hành mà dùng ADO thì e rằng tốc độ tính toán vẫn còn là vấn đề phải bàn lại
--------------------
Hải thử bài này (với dữ liệu bài 17) xem thế nào?
Upvote
0
Quang_Hải
Thành viên gạo cội
- Tham gia
- 21/2/09
- Bài viết
- 6,076
- Được thích
- 8,007
- Nghề nghiệp
- Làm đủ thứ
Bài này nếu dùng list có sẵn như chủ topic yêu cầu e rằng không thể làm được. Vì nếu trùng tên ở cột A mà khác ngày ở cột B thì bước kế tiếp là làm gì? Chịu...
Nếu lọc ra cái danh sách kia và đếm xem dữ liệu duy nhất xuất hiện bao nhiều lần thì xem ra chỉ là bài toán cơ bản. Tuy nhiên với dữ liệu bài 17 thì code chạy cũng phải cần tí thời gian à nghen.
Lần chỉnh sửa cuối:
Upvote
0
Hình như ADO chỉ chạy với 65k dòng thôi bác ạ, bây giờ em mới để ý. Nếu nhiều hơn 65k chắc phải chia ra thành từng khối rồi load nhiều lần. Không biết phiên bản mới hơn có khắc phục được không?
Upvote
0
Thì đã bảo là củ chuối mà anh, còn dùng 2 dic với array thì không khó, hết 1.8s.
A=42240, B=38400, C=19200, E=3840
Lần chỉnh sửa cuối:
Upvote
0
Anh ơi, xem lai công thức giúp e với, e làm ki đc.
Upvote
0
comet_1701
Thành viên tiêu biểu
- Tham gia
- 24/5/14
- Bài viết
- 632
- Được thích
- 459
Chắc là đúng anh ah, đợt trước em thử 80.000 nghìn dòng, ko thấy chạy, cho số dòng nhỏ đi thì lại được
Upvote
0
Bạn có cách nào nhanh hơn chỉ mình với, ko dùng công thức kia cũng đc nhưng ma no chạy lâu lắm, cứ ngồi đợi dài cổ ra.
Upvote
0
Let'GâuGâu
Thành viên mới
- Tham gia
- 12/9/13
- Bài viết
- 3,131
- Được thích
- 2,732
bạn thật là kỳ lạ???!!!
có một đóng bài làm bằng vba, sao bạn ko chọn lấy một cách rồi làm, kẹt tới đâu hỏi tới đó???
tôi toàn là thấy bạn cứ tung những câu vu vơ như "tôi không làm được! tôi không biết làm".......v...v.v.v.
đọc mà thấy nản
Lần chỉnh sửa cuối:
Upvote
0
Bài viết mới nhất
- Question
Xin giúp đỡ về tạo hàm excel với C# và excel-dna
(1 người xem)
Sau 1 tháng Mã Lại reset về 1 trở lên
(2 người xem)
- Question
