CẦN LẤY DỮ LIỆU GẦN NHẤT - XÓA CÁC DỮ LIỆU TRÙNG NHAU

Blue Softs Liên hệ QC

myhiep1811

Thành viên mới
Tham gia
11/2/20
Bài viết
1
Được thích
0
Em chào anh/chị
Anh/ chị giúp em: em có một file excel dữ liệu trùng nhau rất nhiều lần. Em muốn lấy dữ liệu ngày gần nhất và xóa các dữ liệu trùng nhau.Thanks all
 

File đính kèm

  • GIÁ MUA.xlsx
    1.7 MB · Đọc: 26

Lê Duy Thương

Cạo lấy gì gội (Dịch quá không gội được)
Tham gia
14/10/09
Bài viết
3,088
Được thích
4,807
Em chào anh/chị
Anh/ chị giúp em: em có một file excel dữ liệu trùng nhau rất nhiều lần. Em muốn lấy dữ liệu ngày gần nhất và xóa các dữ liệu trùng nhau.Thanks all
dữ liệu lớn như thế này nên dung pivot table nhé
 

Hamedanger

Thành viên chính thức
Tham gia
2/12/14
Bài viết
60
Được thích
23
Bài này mình thấy hay hay, nên thử xử lý bằng VBA. Hy vọng là đúng ý bạn ?
Sang Sheet KetQua chạy code xem thử.

Sub GPE()
Application.ScreenUpdating = False
Dim sRng As Range, iArr As Variant, endR As Long
Sheet2.Range("A2:E1048576").ClearContents
With Sheet1
endR = .Range("A1048576").End(3).Row
.Range("A2:E" & endR).Sort Key1:=.Range("A1"), order1:=xlAscending, _
Key2:=.Range("E1"), order2:=xlDescending, _
Header:=xlYes
iArr = .Range("A2:E" & endR).Value
End With

Dim oArr As Variant, Dic As Object, iDic As Variant, I As Long, J As Long, R As Long
Set Dic = CreateObject("Scripting.Dictionary")
For I = LBound(iArr, 1) To UBound(iArr, 1)
If Not Dic.exists(CStr(iArr(I, 1))) Then Dic.Add CStr(iArr(I, 1)), I
Next

If Dic.Count = 0 Then
Application.ScreenUpdating = True
Exit Sub
End If

ReDim oArr(1 To Dic.Count, 1 To 5)
iDic = Dic.items

For I = LBound(iDic, 1) To UBound(iDic, 1)
R = iDic(I)
For J = 1 To 5
oArr(I + 1, J) = iArr(R, J)
Next
Next

Sheet2.Range("A2").Resize(UBound(oArr, 1), 5) = oArr
Application.ScreenUpdating = True
End Sub
 

File đính kèm

  • GPE.xlsm
    2.2 MB · Đọc: 13

Hoàng Nhật Phương

Thành viên gắn bó
Tham gia
5/11/15
Bài viết
1,782
Được thích
943
Hic hic
Mã:
Option Explicit
Sub Hic_HàNNôi_BanHànhCôngVan_GianCáchCovid_roi_BuonQuaaaaa_huhu()
    Dim dic As Object, data(), rng As Range, i As Long, j As Long, k As Long
    Set dic = CreateObject("Scripting.Dictionary")
    With ThisWorkbook.Worksheets("Sheet1")
        Set rng = .Cells(1, "A").CurrentRegion
        rng.Sort Key1:=.Range("A1"), Order1:=xlAscending, Key2:=.Range("E1"), Order2:=xlDescending, Orientation:=xlTopToBottom, Header:=xlYes
    End With
    data = rng.Value
    For i = 1 To UBound(data, 1)
        If Not dic.Exists(data(i, 1)) Then
            k = k + 1: dic.Add data(i, 1), k
            For j = 1 To UBound(data, 2)
                data(k, j) = data(i, j)
            Next j
        End If
    Next i
    With ThisWorkbook.Worksheets("KetQua").Cells(1, "A")
        .CurrentRegion.ClearContents
        If k Then .Resize(k, UBound(data, 2)).Value = data
    End With
End Sub
 
Lần chỉnh sửa cuối:

Ba Tê

Cạo Rồi Khỏi Gội
Tham gia
5/5/09
Bài viết
12,079
Được thích
17,446
Hic hic
Mã:
Option Explicit
Sub Hic_HàNNôi_BanHànhCôngVan_GianCáchCovid_roi_BuonQuaaaaa_huhu()
    Dim dic As Object, data(), rng As Range, i As Long, j As Long, k As Long
    Set dic = CreateObject("Scripting.Dictionary")
    With ThisWorkbook.Worksheets("Sheet1")
        Set rng = .Cells(1, "A").CurrentRegion
        rng.Sort Key1:=.Range("A1"), Order1:=xlAscending, Key2:=.Range("E1"), Order2:=xlAscending, Orientation:=xlTopToBottom, Header:=xlYes
    End With
    data = rng.Value
    For i = 1 To UBound(data, 1)
        If Not dic.Exists(data(i, 1)) Then
            k = k + 1: dic.Add data(i, 1), k
            For j = 1 To UBound(data, 2)
                data(k, j) = data(i, j)
            Next j
        End If
    Next i
    With ThisWorkbook.Worksheets("KetQua").Cells(1, "A")
        .CurrentRegion.ClearContents
        If k Then .Resize(k, UBound(data, 2)).Value = data
    End With
End Sub
Dữ liệu "nguyên xi" của người ta, đem đi Sort, nhìn lại "lạ hoắc" người ta có chịu không?
Đã xài Dic thì cứ cho nó lung tung cũng được mà.
PHP:
Option Explicit

Sub GPE()
Const CoLs As Long = 5
Dim Dic As Object, sArr(), dArr(), Txt As String
Dim I As Long, J As Long, K As Long, R As Long, Rws As Long
Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = vbTextCompare
    sArr = Sheet1.Range("A1", Sheet1.Range("A1").End(xlDown)).Resize(, CoLs).Value
    R = UBound(sArr)
ReDim dArr(1 To R, 1 To CoLs)
    For I = 1 To R
        Txt = sArr(I, 1)
        If Not Dic.Exists(Txt) Then
            K = K + 1
            Dic.Item(Txt) = K
            For J = 1 To CoLs
                dArr(K, J) = sArr(I, J)
            Next J
        Else
            Rws = Dic.Item(Txt)
            If sArr(I, CoLs) > dArr(Rws, CoLs) Then
                dArr(Rws, 4) = sArr(I, 4)
                dArr(Rws, CoLs) = sArr(I, CoLs)
            End If
        End If
    Next I
    With Sheets("KetQua")
        .Range("A1:A100000").Resize(, CoLs).ClearContents
        If K Then Range("A1").Resize(K, CoLs).Value = dArr
    End With
Set Dic = Nothing
End Sub
 
Lần chỉnh sửa cuối:

Hoàng Nhật Phương

Thành viên gắn bó
Tham gia
5/11/15
Bài viết
1,782
Được thích
943
Dữ liệu "nguyên xi" của người ta, đem đi Sort, nhìn lại "lạ hoắc" người ta có chịu không?
Đã xài Dic thì cứ cho nó lung tung cũng được mà.
PHP:
Option Explicit
Sub Hic_HàNNôi_BanHànhCôngVan_GianCáchCovid_roi_BuonQuaaaaa_huhu()
    Const CoLs As Long = 5
    Dim Dic As Object, Data(), KQ(), i As Long, j As Long, k As Long, R As Long, Rws As Long
    Set Dic = CreateObject("Scripting.Dictionary")
        Data = Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown)).Resize(, CoLs).Value
        Rws = UBound(Data)
    ReDim KQ(1 To Rws, 1 To CoLs)
    For i = 1 To Rws
        If Not Dic.Exists(Data(i, 1)) Then
            k = k + 1:      Dic.Add Data(i, 1), k
            For j = 1 To CoLs
                KQ(k, j) = Data(i, j)
            Next j
        Else
            R = Dic.Item(Data(i, 1))
            If Data(i, 5) > KQ(R, CoLs) Then
                KQ(R, 4) = Data(i, 4):          KQ(R, CoLs) = Data(i, CoLs)
            End If
        End If
    Next i
    With Sheets("KetQua")
        .Range("A2:A100000").Resize(, CoLs).ClearContents
        If k Then Range("A2").Resize(k, CoLs).Value = Data
    End With
End Sub
Con chào Thầy, cảm ơn Thầy đã góp ý cho con ạ.
Dạ phải rồi Thầy ạ,sau khi gửi code lên con cũng có nghĩ thấy không ổn khi thay đổi dữ liệu gốc.
 

Ba Tê

Cạo Rồi Khỏi Gội
Tham gia
5/5/09
Bài viết
12,079
Được thích
17,446
Con chào Thầy, cảm ơn Thầy đã góp ý cho con ạ.
Dạ phải rồi Thầy ạ,sau khi gửi code lên con cũng có nghĩ thấy không ổn khi thay đổi dữ liệu gốc.
Chẳng hiểu sao code tôi sửa dựa theo bài của bạn ra kết quả "tào lao".
Đã gởi lại code ở bài trên.
-------------------------------
Đã thấy sai ở dòng này:
If k Then Range("A2").Resize(k, CoLs).Value = Data
Đúng phải là
If k Then Range("A2").Resize(k, CoLs).Value =KQ
 
Lần chỉnh sửa cuối:

VetMini

Chuyên gia GPE
Tham gia
21/12/12
Bài viết
12,176
Được thích
15,616
dữ liệu lớn như thế này nên dung pivot table nhé
Data Model và Power Pivot chứ.

Tôi có tật chạy theo thời trang. Thời trang mới bi giờ là Power BI. Ba cái VBA cũ xì rồi.
Cứ mấy cái yêu cầu Lọc, Xếp, Trích xuất hằng ngày ở GE này đem cho tụi Power Query, Power Pivot, Data Model chúng xơi tuốt.
 

Hoàng Nhật Phương

Thành viên gắn bó
Tham gia
5/11/15
Bài viết
1,782
Được thích
943
Chẳng hiểu sao code tôi sửa dựa theo bài của bạn ra kết quả "tào lao".
Đã gởi lại code ở bài trên.
-------------------------------
Đã thấy sai ở dòng này:
If k Then Range("A2").Resize(k, CoLs).Value = Data
Đúng phải là
If k Then Range("A2").Resize(k, CoLs).Value =KQ
Cảm ơn Thầy , qua cách làm của Thầy con học thêm được chiêu so sánh ngày trong mảng mà không cần sử dụng tính năng sắp xếp.
So sánh với kết quả của Thầy và của con thì con thấy kết của con bị sai do lấy thông tin của ngày cũ (yêu cầu là ngày mới), hiện con đã sửa lại bài 4:
Mã:
Order2:=xlDescending
Để sắp xếp từ ngày mới đến ngàycũ.
 

VetMini

Chuyên gia GPE
Tham gia
21/12/12
Bài viết
12,176
Được thích
15,616
...Dim I As Long, J As Long, K As Long, R As Long, Rws As Long
Dòng của bạn là dòng thứ tự (chỉ số) chứ không phải là dòng đếm. Tức là nó số ít chứ không phải số nhiều. Đặt tên không cần 's'.
Để phân biệt nó là chỉ số mảng chứ không phải chỉ số dòng bảng tính, bạn nên thêm tiền/hậu tố 'a' (tôi chọn 'a' do mảng của bạn đặt tên có 'Arr')
Tức là aRw, hoặc rwA là đẹp.
 

Hoàng Nhật Phương

Thành viên gắn bó
Tham gia
5/11/15
Bài viết
1,782
Được thích
943
Dữ liệu "nguyên xi" của người ta, đem đi Sort, nhìn lại "lạ hoắc" người ta có chịu không?
Đã xài Dic thì cứ cho nó lung tung cũng được mà.
Theo góp ý của Thầy ,không động chạm đến dữ liệu ban đầu do vậy con thử dùng sort và bỏ Dic ạ:
Mã:
Public Sub TimGiaCuaNgayMoiNHat()
    Dim Data(), Rng As Range, rKQ As Range, i As Long, j As Long, k As Long
    With ThisWorkbook.Worksheets("Sheet1")
        Set Rng = .Cells(1, "A").CurrentRegion
        i = Rng.Columns.Count + 2
        Rng.Offset(, i).Value = Rng.Value
        Set rKQ = .Cells(1, "A").Offset(, i)
        rKQ.CurrentRegion.Sort Key1:=rKQ, Order1:=xlAscending, Key2:=rKQ.Offset(, 4), Order2:=xlDescending, Orientation:=xlTopToBottom, Header:=xlYes
        Data = rKQ.CurrentRegion.Value2: k = 1
        For i = 2 To UBound(Data, 1)
            If Data(i, 1) <> Data(i - 1, 1) Then
                k = k + 1
                For j = 1 To UBound(Data, 2)
                    Data(k, j) = Data(i, j)
                Next j
            End If
        Next i
        rKQ.Offset(1).Resize(Rng.Rows.Count - 1, Rng.Columns.Count).ClearContents
        If k Then rKQ.Resize(k, UBound(Data, 2)).Value = Data
    End With
End Sub
------------
Bác @VetMini ơi, bài toán này mà dùng 'arraylist' có phù hợp không Bác.. nếu phù hợp Bác chỉ cho con dùng như thế nào ạ?
 
Lần chỉnh sửa cuối:

ptm0412

Bad Excel Member
Thành viên BQT
Super Moderator
Tham gia
4/11/07
Bài viết
11,519
Được thích
32,482
Donate (Momo)
Donate
Giới tính
Nam
Nghề nghiệp
Consultant
Ớ,cột A đến E thôi chú Mỹ nhé :D
Con có thấy vấn đề gì đâu ạ.
Vẫn là sort. Sao chép, Sort, rồi xử lý, rồi xoá, rồi điền kết quả. current rồi Offset resize loằng ngoằng. Cứ bám vào 1 thuật toán ban đầu nó khổ vậy á. Đập hết làm lại còn hay hơn
 

Hoàng Nhật Phương

Thành viên gắn bó
Tham gia
5/11/15
Bài viết
1,782
Được thích
943
Vẫn là sort. Sao chép, Sort, rồi xử lý, rồi xoá, rồi điền kết quả. current rồi Offset resize loằng ngoằng. Cứ bám vào 1 thuật toán ban đầu nó khổ vậy á. Đập hết làm lại còn hay hơn
Con cũng đang muốn đập đi xây cái "arraylist" , chú Mỹ xem thế nào giúp con ít vốn. :D
 

Hamedanger

Thành viên chính thức
Tham gia
2/12/14
Bài viết
60
Được thích
23
Sửa lại code #3 , ko cần đụng đến dữ liệu nguồn
Sub GPE()
Const CoLs = 5
Dim iArr As Variant, endR As Long, oArr As Variant, Dic As Object, iDic As Variant
Dim I As Long, J As Long, K As Long, MS As String, idStr As String, R As Long
With Sheet1
endR = .Range("A1048576").End(3).Row
iArr = .Range("A2:E" & endR).Value
End With

Set Dic = CreateObject("Scripting.Dictionary")
For I = LBound(iArr, 1) To UBound(iArr, 1)
MS = CStr(iArr(I, 1))
If Not Dic.Exists(MS) Then
Dic.Add MS, I
Else
idStr = Dic.Item(MS)
If iArr(I, 4) > iArr(idStr, 4) Then
Dic.Remove MS
Dic.Add MS, I
End If
End If
Next

ReDim oArr(1 To Dic.Count, 1 To CoLs)
iDic = Dic.items

For I = LBound(iDic, 1) To UBound(iDic, 1)
R = iDic(I)
For J = 1 To CoLs
oArr(I + 1, J) = iArr(R, J)
Next
Next
With Sheet2
.Range("A2:E1048576").ClearContents
.Range("A2").Resize(UBound(oArr, 1), CoLs) = oArr
End With
End Sub
Bài đã được tự động gộp:

If K Then Range("A1").Resize(K, CoLs).Value = dArr
Cách của A Ba tê thì chỉ phải đi 1 vòng lặp qua dữ liệu gốc nên cho tốc độ nhanh hơn nhưng cái mảng dArr thực tế là thừa dòng so với kết quả thu được. Muốn ko khai thừa lại mất công đảo ngược mảng kết quả rồi redim preserve từng dòng 1 , đến cuối vẫn phải transpose . Tính ra thì vẫn phải đi mất 2 vòng lặp.
Có cách nào chỉ đi 1 vòng mà mảng kết quả có đúng số dòng cần lấy ko nhỉ?
 
Lần chỉnh sửa cuối:

ptm0412

Bad Excel Member
Thành viên BQT
Super Moderator
Tham gia
4/11/07
Bài viết
11,519
Được thích
32,482
Donate (Momo)
Donate
Giới tính
Nam
Nghề nghiệp
Consultant
Có cách nào chỉ đi 1 vòng mà mảng kết quả có đúng số dòng cần lấy ko nhỉ?
Không có cách nào. Ngoài ra khai báo dArr dư cũng có lý do: Phải giả định rằng số dòng kết quả nhiều đến mức gần bằng hoặc bằng dữ liệu gốc. Dữ liệu khác thì có thể ước lượng, có khi ít hơn nhiều, cũng có khi nhiều hơn cả gốc.
Dù gì thì cũng có giới hạn dư chứ không dư quá mức.
 
Top Bottom