XIN ANH CHỊ GIÚP ĐỠ EM CODE LỌC TRÙNG SỐ TRONG 1 SHEET (1 người xem)

[truonghagpex]

em có 1 bảng số gồm 40 cột và 65 000 hàng chứa cá số tự nhiên, trong đó có rất nhiều số trùng lặp nhau bjo em muốn xóa các số trùng lặp chỉ dữ lại 1 số, kết quả mong muốn sau khi chạy là xóa hết các số trùng lặp đó(giữ lại 1) và dồn về đầy các cột gần nhau
***em đã viết code 3 ngày nay nhưng do trình độ yếu nên chỉ chạy số lượng ít thì được còn chạy nhiều thì không chạy nổi, mong anh chị giúp đỡ tối ưu hộ em hoặc có code khác nhẹ hơn giúp em ajh, chân thành cảm ơn anh chị nhiều, trong file đính kèm có cả code kiểm tra trùng rất hay của 1 bạn khác em sưu tầm, nhưng em không phát triển đc

 

[giaiphap]

em có 1 bảng số gồm 40 cột và 65 000 hàng chứa cá số tự nhiên, trong đó có rất nhiều số trùng lặp nhau bjo em muốn xóa các số trùng lặp chỉ dữ lại 1 số, em đã viết code 3 ngày nay nhưng do trình độ yếu nên chỉ chạy số lượng ít thì được còn chạy nhiều thì không chạy nổi, mong anh chị giúp đỡ tối ưu hộ em hoặc có code khác nhẹ hơn giúp em ajh, chân thành cảm ơn anh chị nhiều, trong file đính kèm có cả code kiểm tra trùng rất hay của 1 bạn khác em sưu tầm, nhưng em không phát triển đc

Bạn phải mô tả rõ ràng thì mới giúp được. Kết quả mong muốn sau khi chạy code. Kết quả ghi vào đâu? gồm bao nhiêu cột? Dữ liệu cũ sau khi chạy code sẽ như thế nào?...

 

[truonghagpex]

Bạn phải mô tả rõ ràng thì mới giúp được. Kết quả mong muốn sau khi chạy code. Kết quả ghi vào đâu? gồm bao nhiêu cột? Dữ liệu cũ sau khi chạy code sẽ như thế nào?...

rất cảm ơn anh đã quan tâm em chỉnh lại rồi ajh, em chỉ mong muốn xóa các số trùng nhau(giữ lại 1) còn việc dồn em có thể thủ công ạh

 

[snow25]

em có 1 bảng số gồm 40 cột và 65 000 hàng chứa cá số tự nhiên, trong đó có rất nhiều số trùng lặp nhau bjo em muốn xóa các số trùng lặp chỉ dữ lại 1 số, kết quả mong muốn sau khi chạy là xóa hết các số trùng lặp đó(giữ lại 1) và dồn về đầy các cột gần nhau
***em đã viết code 3 ngày nay nhưng do trình độ yếu nên chỉ chạy số lượng ít thì được còn chạy nhiều thì không chạy nổi, mong anh chị giúp đỡ tối ưu hộ em hoặc có code khác nhẹ hơn giúp em ajh, chân thành cảm ơn anh chị nhiều, trong file đính kèm có cả code kiểm tra trùng rất hay của 1 bạn khác em sưu tầm, nhưng em không phát triển đc

Bên này mình đã viết code rồi mà .
https://giaiphapexcel.com/diendan/t...iễn-đàn-giúp-đỡ-em-với-ạh.139858/#post-898471

 

[truonghagpex]

Bên này mình đã viết code rồi mà .
https://giaiphapexcel.com/diendan/threads/xin-anh-chị-code-lọc-trùng-bảng-500-ngìn-sĐt-em-đọc-và-mãi-vẫn-không-thể-viết-được-đoạn-code-đó-mong-anh-chị-diễn-đàn-giúp-đỡ-em-với-ạh.139858/#post-898471

mình tìm mãi bạn để tag vào đây mà không được, đoạn code đó chạy không được bạn ajh chạy xong vần nguyên như cũ ạh

 

[Ba Tê]

mình tìm mãi bạn để tag vào đây mà không được, đoạn code đó chạy không được bạn ajh chạy xong vần nguyên như cũ ạh

Bạn tham khảo file này, có duyên thì dùng.

 

[CHAOQUAY]

em có 1 bảng số gồm 40 cột và 65 000 hàng chứa cá số tự nhiên, trong đó có rất nhiều số trùng lặp nhau bjo em muốn xóa các số trùng lặp chỉ dữ lại 1 số, kết quả mong muốn sau khi chạy là xóa hết các số trùng lặp đó(giữ lại 1) và dồn về đầy các cột gần nhau
***em đã viết code 3 ngày nay nhưng do trình độ yếu nên chỉ chạy số lượng ít thì được còn chạy nhiều thì không chạy nổi, mong anh chị giúp đỡ tối ưu hộ em hoặc có code khác nhẹ hơn giúp em ajh, chân thành cảm ơn anh chị nhiều, trong file đính kèm có cả code kiểm tra trùng rất hay của 1 bạn khác em sưu tầm, nhưng em không phát triển đc

Bạn gui 1 file có số dòng cột như thật lên dể test tôc độ xem sao

 

[truonghagpex]

mình tìm mãi bạn để tag vào đây mà không được, đoạn code đó chạy không được bạn ajh chạy xong vần nguyên như cũ ạh

afh em thử được rồi ajh chạy ngon lành anh ajh, nhưng có 1 vấn đề là bảng thì 20 cột bảng thì 30 cột nên anh sử dụng hộ em cái
Set vdl = Application.InputBox("CHON VUNG DU LIEU BAN CAN SAP XEP", "TRUONG HA - SAP XEP", , , , , , 8)
để em thay đổi vùng lọc được không anh ơi, em cảm ơn anh ạh

Bài đã được tự động gộp: 24/12/18

Bạn gui 1 file có số dòng cột như thật lên dể test tôc độ xem sao

file đó mình gửi nhưng nó báo lớn quá không gửi đc ajh nó gồm 65452 dòng và cột thì 3- cột có bảng 40 cột ạh

 

[snow25]

afh em thử được rồi ajh chạy ngon lành anh ajh, nhưng có 1 vấn đề là bảng thì 20 cột bảng thì 30 cột nên anh sử dụng hộ em cái
Set vdl = Application.InputBox("CHON VUNG DU LIEU BAN CAN SAP XEP", "TRUONG HA - SAP XEP", , , , , , 8)
để em thay đổi vùng lọc được không anh ơi, em cảm ơn anh ạh

Bài đã được tự động gộp: 24/12/18

file đó mình gửi nhưng nó báo lớn quá không gửi đc ajh nó gồm 65452 dòng và cột thì 3- cột có bảng 40 cột ạh

Đây bạn xem.

Sub loctrung()
Dim arr, arr1, vd
Dim dic As Object, dk As String, max As Long
Dim lr As Long, i As Long, j As Long, a As Long
Set dic = CreateObject("scripting.dictionary")
Set vd = Application.InputBox("CHON VUNG DU LIEU BAN CAN SAP XEP", "TRUONG HA - SAP XEP", , , , , , 8)
     arr = vd.Value2
     ReDim arr1(1 To UBound(arr, 1), 1 To UBound(arr, 2))
     For i = 1 To UBound(arr, 2)
         a = 0
         For j = 1 To UBound(arr, 1)
          If Len(arr(j, i)) > 0 Then
              dk = arr(j, i)
              If Not dic.exists(dk) Then
                 a = a + 1
                 arr1(a, i) = dk
                 dic.Add dk, ""
              End If
          End If
         Next j
        If max < a Then max = a
     Next i
With Sheet3
   .Range("a2").Resize(Rows.Count - 2, 100).ClearContents
   If max Then .Range("a2").Resize(max, UBound(arr, 2)).Value = arr1
End With
End Sub

 

[HieuCD]

em có 1 bảng số gồm 40 cột và 65 000 hàng chứa cá số tự nhiên, trong đó có rất nhiều số trùng lặp nhau bjo em muốn xóa các số trùng lặp chỉ dữ lại 1 số, kết quả mong muốn sau khi chạy là xóa hết các số trùng lặp đó(giữ lại 1) và dồn về đầy các cột gần nhau
***em đã viết code 3 ngày nay nhưng do trình độ yếu nên chỉ chạy số lượng ít thì được còn chạy nhiều thì không chạy nổi, mong anh chị giúp đỡ tối ưu hộ em hoặc có code khác nhẹ hơn giúp em ajh, chân thành cảm ơn anh chị nhiều, trong file đính kèm có cả code kiểm tra trùng rất hay của 1 bạn khác em sưu tầm, nhưng em không phát triển đc

Code xử toàn bộ dữ liệu các sheet không từ già trẻ lớn bé, cẩn thận khi chạy code

Sub LoaiTrungTatCa()
  Dim sArr(), Res(), ws As Worksheet
  Dim i As Long, n As Long, sRow As Long, j As Integer, iKey
  Const sCol As Byte = 20 'Só cot ket qua

  For Each ws In ThisWorkbook.Sheets
    On Error GoTo Tiep
    sArr = ws.UsedRange.Value
    With CreateObject("scripting.dictionary")
      For i = 1 To UBound(sArr)
        For j = 1 To UBound(sArr, 2)
          iKey = CStr(sArr(i, j)) 'Tang toc Dic khi du lieu lon
          If Len(iKey) > 0 Then
            If .exists(iKey) = False Then .Add iKey, Empty
          End If
        Next j
      Next i
      n = .Count
      If n > 0 Then
        sRow = (n - 1) \ sCol + 1
        ReDim Res(1 To sRow, 1 To sCol)
        i = 1: j = 0
        For Each iKey In .keys
          If j = sCol Then
            j = 1: i = i + 1
          Else
            j = j + 1
          End If
          Res(i, j) = iKey
        Next iKey
        ws.UsedRange.Clear
        ws.Range("A1").Resize(sRow, sCol).NumberFormat = "#"
        ws.Range("A1").Resize(sRow, sCol) = Res
      End If
    End With
Tiep:
    On Error GoTo 0
  Next ws
End Sub

 

[snow25]

Code xử toàn bộ dữ liệu các sheet không từ già trẻ lớn bé, cẩn thận khi chạy code

Sub LoaiTrungTatCa()
  Dim sArr(), Res(), ws As Worksheet
  Dim i As Long, n As Long, sRow As Long, j As Integer, iKey
  Const sCol As Byte = 20 'Só cot ket qua

  For Each ws In ThisWorkbook.Sheets
    If ws.Name <> "Sheet1" Then
    On Error GoTo Tiep
    sArr = ws.UsedRange.Value
    With CreateObject("scripting.dictionary")
      For i = 1 To UBound(sArr)
        For j = 1 To UBound(sArr, 2)
          iKey = CStr(sArr(i, j)) 'Tang toc Dic khi du lieu lon
          If Len(iKey) > 0 Then
            If .exists(iKey) = False Then .Add iKey, Empty
          End If
        Next j
      Next i
      n = .Count
      If n > 0 Then
        sRow = (n - 1) \ sCol + 1
        ReDim Res(1 To sRow, 1 To sCol)
        i = 1: j = 0
        For Each iKey In .keys
          If j = sCol Then
            j = 1: i = i + 1
          Else
            j = j + 1
          End If
          Res(i, j) = iKey
        Next iKey
        ws.UsedRange.Clear
        ws.Range("A1").Resize(sRow, sCol).NumberFormat = "#"
        ws.Range("A1").Resize(sRow, sCol) = Res
      End If
    End With
Tiep:
    On Error GoTo 0
    End If
  Next ws
End Sub

Anh Hiếu ơi code này nó vẫn từ Sheet1
If ws.Name <> "Sheet1" Then

 

[HieuCD]

Anh Hiếu ơi code này nó vẫn từ Sheet1
If ws.Name <> "Sheet1" Then

Mình test các sheet khác sheet1, quên chỉnh lại code
Chúc bạn vui cả ngày