Lọc dữ liệu trùng mảng 2 chiều dùng Dictionary (1 người xem)

huhumalu · 3/9/20

ndu96081631 đã viết:
1 cell thì isEmpty chứ 3 cells gộp lại, có dấu"#" phân cách ở giữa thì nó hết Empty rồi bạn à

Anh làm em từ hiểu chút chút thành hết hiểu luôn.
Nhờ anh ra tay giúp, viết chạy rồi toàn debug để dòm, nên suy luận còn chưa hình dung ra hết.

ndu96081631 · 4/9/20

huhumalu đã viết:
Anh làm em từ hiểu chút chút thành hết hiểu luôn.
Nhờ anh ra tay giúp, viết chạy rồi toàn debug để dòm, nên suy luận còn chưa hình dung ra hết.

Code tổng quát lọc duy nhất theo vị trí cột tùy ý:

Mã:

Function RemoveDups(ByVal SourceArray As Variant, Optional ByVal Columns As Variant = "*")
  Dim aSource
  Dim vRowItem
  Dim dic       As Object
  Dim sKey      As String
  Dim lCol      As Long
  Dim lRow      As Long
  Dim HasData   As Boolean
 
  Set dic = CreateObject("scripting.dictionary")
  aSource = SourceArray
 
  If Not IsArray(Columns) Then
    If Columns = "*" Then
      ReDim aCols(LBound(aSource, 2) To UBound(aSource, 2))
      For lCol = LBound(aSource, 2) To UBound(aSource, 2)
        aCols(lCol) = lCol
      Next
    Else
      ReDim aCols(0)
      aCols(0) = Columns
    End If
  Else
    aCols = Columns
  End If
  ReDim aKey(LBound(aCols) To UBound(aCols))
 
  For lRow = LBound(aSource, 1) To UBound(aSource, 1)
    HasData = False
    For lCol = LBound(aCols) To UBound(aCols)
      aKey(lCol) = aSource(lRow, aCols(lCol))
      If Not IsEmpty(aKey(lCol)) Then HasData = True
      If TypeName(aKey(lCol)) = "Error" Then
        HasData = False
        Exit For
      End If
    Next
    If HasData Then
      sKey = Join(aKey, vbBack)
      If Not dic.exists(sKey) Then dic.Add sKey, lRow
    End If
  Next
  If dic.Count Then
    lRow = 0: lCol = 0
    ReDim aRes(1 To dic.Count, LBound(aSource, 2) To UBound(aSource, 2))
    For Each vRowItem In dic.items
      lRow = lRow + 1
      For lCol = LBound(aSource, 2) To UBound(aSource, 2)
        aRes(lRow, lCol) = aSource(vRowItem, lCol)
      Next
    Next
    RemoveDups = aRes
  End If
End Function

Ghi chú:
- SourceArray: Nguồn dữ liệu, có thể là vùng dữ liệu trên sheet, cũng có thể là mảng nằm ở đâu đó trên listbox, combobox hoặc mảng do công thức trả về
- Columns: Là những cột mà bạn muốn lấy duy nhất. Nó có thể là một hoặc nhiều cột. Nếu bỏ qua tham số này hoặc ghi là "*" thì xem như là lọc duy nhất toàn bộ các cột
- Hàm này không lấy dòng rổng, không lấy dòng có cell bị lỗi
Cách dùng:

Mã:

Sub Main()
  Dim rng As Range, aRes
  Set rng = Sheet1.Range("O6:Q1000")
  'aRes = RemoveDups(rng, "*")             ''<--- Lọc duy nhất toàn bộ các cột
  'aRes = RemoveDups(rng, 2)                ''<--- Lọc duy nhất theo cột 2
  aRes = RemoveDups(rng, Array(1, 2))  ''<--- Lọc duy nhất theo cột 1 và cột 2
  If IsArray(aRes) Then
    Range("K6:M1000").ClearContents
    Range("K6").Resize(UBound(aRes, 1), UBound(aRes, 2)).Value = aRes
  End If
End Sub

Code trên lọc duy nhất vùng dữ liệu O6:Q1000 theo cột 1 và cột 2, đặt kết quả tại cell K6
----------------------------------------------------------
Cũng không chắc còn lỗi nào không? Mời bạn kiểm tra giúp

HieuCD · 4/9/20

ndu96081631 đã viết:
Code tổng quát lọc duy nhất theo vị trí cột tùy ý:

Mã:

Function RemoveDups(ByVal SourceArray As Variant, Optional ByVal Columns As Variant = "*") Dim aSource Dim vRowItem Dim dic As Object Dim sKey As String Dim lCol As Long Dim lRow As Long Dim HasData As Boolean Set dic = CreateObject("scripting.dictionary") aSource = SourceArray If Not IsArray(Columns) Then If Columns = "*" Then ReDim aCols(LBound(aSource, 2) To UBound(aSource, 2)) For lCol = LBound(aSource, 2) To UBound(aSource, 2) aCols(lCol) = lCol Next Else ReDim aCols(0) aCols(0) = Columns End If Else aCols = Columns End If ReDim aKey(LBound(aCols) To UBound(aCols)) For lRow = LBound(aSource, 1) To UBound(aSource, 1) HasData = False For lCol = LBound(aCols) To UBound(aCols) aKey(lCol) = aSource(lRow, aCols(lCol)) If Not IsEmpty(aKey(lCol)) Then HasData = True If TypeName(aKey(lCol)) = "Error" Then HasData = False Exit For End If Next If HasData Then sKey = Join(aKey, vbBack) If Not dic.exists(sKey) Then dic.Add sKey, lRow End If Next If dic.Count Then lRow = 0: lCol = 0 ReDim aRes(1 To dic.Count, LBound(aSource, 2) To UBound(aSource, 2)) For Each vRowItem In dic.items lRow = lRow + 1 For lCol = LBound(aSource, 2) To UBound(aSource, 2) aRes(lRow, lCol) = aSource(vRowItem, lCol) Next Next RemoveDups = aRes End If End Function

Ghi chú:
- SourceArray: Nguồn dữ liệu, có thể là vùng dữ liệu trên sheet, cũng có thể là mảng nằm ở đâu đó trên listbox, combobox hoặc mảng do công thức trả về
- Columns: Là những cột mà bạn muốn lấy duy nhất. Nó có thể là một hoặc nhiều cột. Nếu bỏ qua tham số này hoặc ghi là "*" thì xem như là lọc duy nhất toàn bộ các cột
- Hàm này không lấy dòng rổng, không lấy dòng có cell bị lỗi
Cách dùng:

Mã:

Sub Main() Dim rng As Range, aRes Set rng = Sheet1.Range("O6:Q1000") 'aRes = RemoveDups(rng, "*") ''<--- Lọc duy nhất toàn bộ các cột 'aRes = RemoveDups(rng, 2) ''<--- Lọc duy nhất theo cột 2 aRes = RemoveDups(rng, Array(1, 2)) ''<--- Lọc duy nhất theo cột 1 và cột 2 If IsArray(aRes) Then Range("K6:M1000").ClearContents Range("K6").Resize(UBound(aRes, 1), UBound(aRes, 2)).Value = aRes End If End Sub

Code trên lọc duy nhất vùng dữ liệu O6:Q1000 theo cột 1 và cột 2, đặt kết quả tại cell K6
----------------------------------------------------------
Cũng không chắc còn lỗi nào không? Mời bạn kiểm tra giúp

Thử lệnh
a = RemoveDups([a2:b4], Array(1, 3))
bị lổi

Bài đã được tự động gộp: 4/9/20

ndu96081631 đã viết:
Code tổng quát lọc duy nhất theo vị trí cột tùy ý:

Mã:

Function RemoveDups(ByVal SourceArray As Variant, Optional ByVal Columns As Variant = "*") Dim aSource Dim vRowItem Dim dic As Object Dim sKey As String Dim lCol As Long Dim lRow As Long Dim HasData As Boolean Set dic = CreateObject("scripting.dictionary") aSource = SourceArray If Not IsArray(Columns) Then If Columns = "*" Then ReDim aCols(LBound(aSource, 2) To UBound(aSource, 2)) For lCol = LBound(aSource, 2) To UBound(aSource, 2) aCols(lCol) = lCol Next Else ReDim aCols(0) aCols(0) = Columns End If Else aCols = Columns End If ReDim aKey(LBound(aCols) To UBound(aCols)) For lRow = LBound(aSource, 1) To UBound(aSource, 1) HasData = False For lCol = LBound(aCols) To UBound(aCols) aKey(lCol) = aSource(lRow, aCols(lCol)) If Not IsEmpty(aKey(lCol)) Then HasData = True If TypeName(aKey(lCol)) = "Error" Then HasData = False Exit For End If Next If HasData Then sKey = Join(aKey, vbBack) If Not dic.exists(sKey) Then dic.Add sKey, lRow End If Next If dic.Count Then lRow = 0: lCol = 0 ReDim aRes(1 To dic.Count, LBound(aSource, 2) To UBound(aSource, 2)) For Each vRowItem In dic.items lRow = lRow + 1 For lCol = LBound(aSource, 2) To UBound(aSource, 2) aRes(lRow, lCol) = aSource(vRowItem, lCol) Next Next RemoveDups = aRes End If End Function

Ghi chú:
- SourceArray: Nguồn dữ liệu, có thể là vùng dữ liệu trên sheet, cũng có thể là mảng nằm ở đâu đó trên listbox, combobox hoặc mảng do công thức trả về
- Columns: Là những cột mà bạn muốn lấy duy nhất. Nó có thể là một hoặc nhiều cột. Nếu bỏ qua tham số này hoặc ghi là "*" thì xem như là lọc duy nhất toàn bộ các cột
- Hàm này không lấy dòng rổng, không lấy dòng có cell bị lỗi
Cách dùng:

Mã:

Sub Main() Dim rng As Range, aRes Set rng = Sheet1.Range("O6:Q1000") 'aRes = RemoveDups(rng, "*") ''<--- Lọc duy nhất toàn bộ các cột 'aRes = RemoveDups(rng, 2) ''<--- Lọc duy nhất theo cột 2 aRes = RemoveDups(rng, Array(1, 2)) ''<--- Lọc duy nhất theo cột 1 và cột 2 If IsArray(aRes) Then Range("K6:M1000").ClearContents Range("K6").Resize(UBound(aRes, 1), UBound(aRes, 2)).Value = aRes End If End Sub

Code trên lọc duy nhất vùng dữ liệu O6:Q1000 theo cột 1 và cột 2, đặt kết quả tại cell K6
----------------------------------------------------------
Cũng không chắc còn lỗi nào không? Mời bạn kiểm tra giúp

Tùy quan điểm mỗi người, theo mình nên lấy dòng tô vàng trong file

vanaccex · 4/9/20

ndu96081631 đã viết:
Code tổng quát lọc duy nhất theo vị trí cột tùy ý:

Mã:

Function RemoveDups(ByVal SourceArray As Variant, Optional ByVal Columns As Variant = "*") Dim aSource Dim vRowItem Dim dic As Object Dim sKey As String Dim lCol As Long Dim lRow As Long Dim HasData As Boolean Set dic = CreateObject("scripting.dictionary") aSource = SourceArray If Not IsArray(Columns) Then If Columns = "*" Then ReDim aCols(LBound(aSource, 2) To UBound(aSource, 2)) For lCol = LBound(aSource, 2) To UBound(aSource, 2) aCols(lCol) = lCol Next Else ReDim aCols(0) aCols(0) = Columns End If Else aCols = Columns End If ReDim aKey(LBound(aCols) To UBound(aCols)) For lRow = LBound(aSource, 1) To UBound(aSource, 1) HasData = False For lCol = LBound(aCols) To UBound(aCols) aKey(lCol) = aSource(lRow, aCols(lCol)) If Not IsEmpty(aKey(lCol)) Then HasData = True If TypeName(aKey(lCol)) = "Error" Then HasData = False Exit For End If Next If HasData Then sKey = Join(aKey, vbBack) If Not dic.exists(sKey) Then dic.Add sKey, lRow End If Next If dic.Count Then lRow = 0: lCol = 0 ReDim aRes(1 To dic.Count, LBound(aSource, 2) To UBound(aSource, 2)) For Each vRowItem In dic.items lRow = lRow + 1 For lCol = LBound(aSource, 2) To UBound(aSource, 2) aRes(lRow, lCol) = aSource(vRowItem, lCol) Next Next RemoveDups = aRes End If End Function

Ghi chú:
- SourceArray: Nguồn dữ liệu, có thể là vùng dữ liệu trên sheet, cũng có thể là mảng nằm ở đâu đó trên listbox, combobox hoặc mảng do công thức trả về
- Columns: Là những cột mà bạn muốn lấy duy nhất. Nó có thể là một hoặc nhiều cột. Nếu bỏ qua tham số này hoặc ghi là "*" thì xem như là lọc duy nhất toàn bộ các cột
- Hàm này không lấy dòng rổng, không lấy dòng có cell bị lỗi
Cách dùng:

Mã:

Sub Main() Dim rng As Range, aRes Set rng = Sheet1.Range("O6:Q1000") 'aRes = RemoveDups(rng, "*") ''<--- Lọc duy nhất toàn bộ các cột 'aRes = RemoveDups(rng, 2) ''<--- Lọc duy nhất theo cột 2 aRes = RemoveDups(rng, Array(1, 2)) ''<--- Lọc duy nhất theo cột 1 và cột 2 If IsArray(aRes) Then Range("K6:M1000").ClearContents Range("K6").Resize(UBound(aRes, 1), UBound(aRes, 2)).Value = aRes End If End Sub

Code trên lọc duy nhất vùng dữ liệu O6:Q1000 theo cột 1 và cột 2, đặt kết quả tại cell K6
----------------------------------------------------------
Cũng không chắc còn lỗi nào không? Mời bạn kiểm tra giúp

Anh @ndu96081631 cho em Vân hỏi với ! Với hàm này có thể chỉnh chỉ lọc những dữ liệu trùng nhau không ạ ?

Em Vân cảm ơn anh a !

huhumalu · 4/9/20

ndu96081631 đã viết:
Code tổng quát lọc duy nhất theo vị trí cột tùy ý:

Mã:

Function RemoveDups(ByVal SourceArray As Variant, Optional ByVal Columns As Variant = "*") Dim aSource Dim vRowItem Dim dic As Object Dim sKey As String Dim lCol As Long Dim lRow As Long Dim HasData As Boolean Set dic = CreateObject("scripting.dictionary") aSource = SourceArray If Not IsArray(Columns) Then If Columns = "*" Then ReDim aCols(LBound(aSource, 2) To UBound(aSource, 2)) For lCol = LBound(aSource, 2) To UBound(aSource, 2) aCols(lCol) = lCol Next Else ReDim aCols(0) aCols(0) = Columns End If Else aCols = Columns End If ReDim aKey(LBound(aCols) To UBound(aCols)) For lRow = LBound(aSource, 1) To UBound(aSource, 1) HasData = False For lCol = LBound(aCols) To UBound(aCols) aKey(lCol) = aSource(lRow, aCols(lCol)) If Not IsEmpty(aKey(lCol)) Then HasData = True If TypeName(aKey(lCol)) = "Error" Then HasData = False Exit For End If Next If HasData Then sKey = Join(aKey, vbBack) If Not dic.exists(sKey) Then dic.Add sKey, lRow End If Next If dic.Count Then lRow = 0: lCol = 0 ReDim aRes(1 To dic.Count, LBound(aSource, 2) To UBound(aSource, 2)) For Each vRowItem In dic.items lRow = lRow + 1 For lCol = LBound(aSource, 2) To UBound(aSource, 2) aRes(lRow, lCol) = aSource(vRowItem, lCol) Next Next RemoveDups = aRes End If End Function

Ghi chú:
- SourceArray: Nguồn dữ liệu, có thể là vùng dữ liệu trên sheet, cũng có thể là mảng nằm ở đâu đó trên listbox, combobox hoặc mảng do công thức trả về
- Columns: Là những cột mà bạn muốn lấy duy nhất. Nó có thể là một hoặc nhiều cột. Nếu bỏ qua tham số này hoặc ghi là "*" thì xem như là lọc duy nhất toàn bộ các cột
- Hàm này không lấy dòng rổng, không lấy dòng có cell bị lỗi
Cách dùng:

Mã:

Sub Main() Dim rng As Range, aRes Set rng = Sheet1.Range("O6:Q1000") 'aRes = RemoveDups(rng, "*") ''<--- Lọc duy nhất toàn bộ các cột 'aRes = RemoveDups(rng, 2) ''<--- Lọc duy nhất theo cột 2 aRes = RemoveDups(rng, Array(1, 2)) ''<--- Lọc duy nhất theo cột 1 và cột 2 If IsArray(aRes) Then Range("K6:M1000").ClearContents Range("K6").Resize(UBound(aRes, 1), UBound(aRes, 2)).Value = aRes End If End Sub

Code trên lọc duy nhất vùng dữ liệu O6:Q1000 theo cột 1 và cột 2, đặt kết quả tại cell K6
----------------------------------------------------------
Cũng không chắc còn lỗi nào không? Mời bạn kiểm tra giúp

Cảm ơn anh ndu96081631 rất nhiều. Code chạy ngon lành ạ.

ndu96081631 · 4/9/20

HieuCD đã viết:
Thử lệnh
a = RemoveDups([a2:b4], Array(1, 3))
bị lổi

Đúng là tôi chưa tính tới cái lỗi cố tình này
Đã định On Error Resume Next lên đầu code rồi nhưng thôi, cứ để vậy, còn lỗi nào mình sẽ giải quyết tận gốc luôn
----------------------------------------

vanaccex đã viết:
Anh @ndu96081631 cho em Vân hỏi với ! Với hàm này có thể chỉnh chỉ lọc những dữ liệu trùng nhau không ạ ?

Em Vân cảm ơn anh a !

Bạn cho ví dụ cụ thể xem, tôi chưa hiểu lắm

vanaccex · 4/9/20

ndu96081631 đã viết:
Đúng là tôi chưa tính tới cái lỗi cố tình này
Đã định On Error Resume Next lên đầu code rồi nhưng thôi, cứ để vậy, còn lỗi nào mình sẽ giải quyết tận gốc luôn
----------------------------------------

Bạn cho ví dụ cụ thể xem, tôi chưa hiểu lắm

Dạ với ví dụ ở trên file của anh . Em Vân chỉ muốn hiểu thị kết quả là : cho vùng điều kiện là cả 3 cột O6:Q1000

aaa	111	600.000
aaa	111	600.000

Em Vân cảm ơn anh ạ!

tigertiger · 4/9/20

ndu96081631 đã viết:
Code tổng quát lọc duy nhất theo vị trí cột tùy ý:

Mã:

Function RemoveDups(ByVal SourceArray As Variant, Optional ByVal Columns As Variant = "*") Dim aSource Dim vRowItem Dim dic As Object Dim sKey As String Dim lCol As Long Dim lRow As Long Dim HasData As Boolean Set dic = CreateObject("scripting.dictionary") aSource = SourceArray If Not IsArray(Columns) Then If Columns = "*" Then ReDim aCols(LBound(aSource, 2) To UBound(aSource, 2)) For lCol = LBound(aSource, 2) To UBound(aSource, 2) aCols(lCol) = lCol Next Else ReDim aCols(0) aCols(0) = Columns End If Else aCols = Columns End If ReDim aKey(LBound(aCols) To UBound(aCols)) For lRow = LBound(aSource, 1) To UBound(aSource, 1) HasData = False For lCol = LBound(aCols) To UBound(aCols) aKey(lCol) = aSource(lRow, aCols(lCol)) If Not IsEmpty(aKey(lCol)) Then HasData = True If TypeName(aKey(lCol)) = "Error" Then HasData = False Exit For End If Next If HasData Then sKey = Join(aKey, vbBack) If Not dic.exists(sKey) Then dic.Add sKey, lRow End If Next If dic.Count Then lRow = 0: lCol = 0 ReDim aRes(1 To dic.Count, LBound(aSource, 2) To UBound(aSource, 2)) For Each vRowItem In dic.items lRow = lRow + 1 For lCol = LBound(aSource, 2) To UBound(aSource, 2) aRes(lRow, lCol) = aSource(vRowItem, lCol) Next Next RemoveDups = aRes End If End Function

Ghi chú:
- SourceArray: Nguồn dữ liệu, có thể là vùng dữ liệu trên sheet, cũng có thể là mảng nằm ở đâu đó trên listbox, combobox hoặc mảng do công thức trả về
- Columns: Là những cột mà bạn muốn lấy duy nhất. Nó có thể là một hoặc nhiều cột. Nếu bỏ qua tham số này hoặc ghi là "*" thì xem như là lọc duy nhất toàn bộ các cột
- Hàm này không lấy dòng rổng, không lấy dòng có cell bị lỗi
Cách dùng:

Mã:

Sub Main() Dim rng As Range, aRes Set rng = Sheet1.Range("O6:Q1000") 'aRes = RemoveDups(rng, "*") ''<--- Lọc duy nhất toàn bộ các cột 'aRes = RemoveDups(rng, 2) ''<--- Lọc duy nhất theo cột 2 aRes = RemoveDups(rng, Array(1, 2)) ''<--- Lọc duy nhất theo cột 1 và cột 2 If IsArray(aRes) Then Range("K6:M1000").ClearContents Range("K6").Resize(UBound(aRes, 1), UBound(aRes, 2)).Value = aRes End If End Sub

Code trên lọc duy nhất vùng dữ liệu O6:Q1000 theo cột 1 và cột 2, đặt kết quả tại cell K6
----------------------------------------------------------
Cũng không chắc còn lỗi nào không? Mời bạn kiểm tra giúp

Hiện đại hại điện bác ạ, Tổng quát có khác, bác xét cẩn trọng thật
Đúng là nếu cứ xét tới xét lui, đủ điều kiện về Data (không chuẩn/ chưa chuẩn) thì sẽ phải tốn năng lượng (dùng code xét lên xét xuống)

Thường thì Data phải chuẩn thì code mới gọn được. Nếu người ứng dụng lo data mình không chuẩn thì sử dụng kiểu tổng quảt thế này. Còn ngược lại thì nên sử dụng hàm đơn giản đỡ tốn năng lượng.

ndu96081631 · 4/9/20

tigertiger đã viết:
Hiện đại hại điện bác ạ, Tổng quát có khác, bác xét cẩn trọng thật
Đúng là nếu cứ xét tới xét lui, đủ điều kiện về Data (không chuẩn/ chưa chuẩn) thì sẽ phải tốn năng lượng (dùng code xét lên xét xuống)

Thường thì Data phải chuẩn thì code mới gọn được. Nếu người ứng dụng lo data mình không chuẩn thì sử dụng kiểu tổng quảt thế này. Còn ngược lại thì nên sử dụng hàm đơn giản đỡ tốn năng lượng.

Vâng! Tôi cũng suy nghĩ lại rồi, đúng là không thể rào hết toàn bộ các lỗi, nhất là những lỗi cố tình. Ngay cả các hàm của MS cũng vậy, nếu ta cố tình làm cho đối số của hàm vượt ra khỏi giới hạn thì nó cũng phải báo lỗi thôi. Ví dụ:

Mã:

=VLOOKUP(V7,O6:Q16,4,0)

vùng dữ liệu có 3 cột mà đòi tìm ở cột 4 thì.. thua, chỉ có nước báo #REF! mà thôi
Vậy nên tôi quyết định giải quyết ý kiến ở bài 23 theo cách:

Mã:

Function RemoveDups(ByVal SourceArray As Variant, Optional ByVal Columns As Variant = "*")
....................................
....................................
  
  On Error GoTo ErrHandler
....................................  
 ....................................
  Set dic = Nothing
  Exit Function
ErrHandler:
  Set dic = Nothing
  MsgBox Err.Description
End Function

Đại khái vậy

tigertiger · 4/9/20

ndu96081631 đã viết:
Vâng! Tôi cũng suy nghĩ lại rồi, đúng là không thể rào hết toàn bộ các lỗi, nhất là những lỗi cố tình. Ngay cả các hàm của MS cũng vậy, nếu ta cố tình làm cho đối số của hàm vượt ra khỏi giới hạn thì nó cũng phải báo lỗi thôi. Ví dụ:

Mã:

=VLOOKUP(V7,O6:Q16,4,0)

vùng dữ liệu có 3 cột mà đòi tìm ở cột 4 thì.. thua, chỉ có nước báo #REF! mà thôi
Vậy nên tôi quyết định giải quyết ý kiến ở bài 23 theo cách:

Mã:

Function RemoveDups(ByVal SourceArray As Variant, Optional ByVal Columns As Variant = "*") .................................... .................................... On Error GoTo ErrHandler .................................... .................................... Set dic = Nothing Exit Function ErrHandler: Set dic = Nothing MsgBox Err.Description End Function

Đại khái vậy

Trong hàm thì ta nên thay
MsgBox Err.Description
Thành

RemoveDups=Err.Description

ndu96081631 · 4/9/20

vanaccex đã viết:
Dạ với ví dụ ở trên file của anh . Em Vân chỉ muốn hiểu thị kết quả là : cho vùng điều kiện là cả 3 cột O6:Q1000

aaa
111
600.000
aaa
111
600.000

Em Vân cảm ơn anh ạ!

Đang suy nghĩ bài của bạn liệu có thể dùng Advanced Filter được không?

vanaccex · 4/9/20

ndu96081631 đã viết:
Đang suy nghĩ bài của bạn liệu có thể dùng Advanced Filter được không?

Dạ bài này hiện tại em Vân đang nêu ở trên có thể dùng Advanced Filter anh ạ

HeSanbi · 4/9/20

Code của thầy ndu96081631, Tôi chuẩn hóa lại giúp bạn để tiện dụng hơn. Bạn có thể tham khảo thêm ADODB để xử lý dữ liệu lớn.

Bạn có thể vận dụng đa dạng như sau:

1. RemoveDups(rng, Array(1, 2,4))
2. RemoveDups(rng, "1,2,18")
3. RemoveDups(rng, "O,Q,S")
4. RemoveDups(rng, "B,O:Q")
5. RemoveDups(rng, [K3:L3])
6. RemoveDups(rng, "*")
7. RemoveDups(rng, "")

Thêm hai tham số tùy chọn, phân biệt hoa thường với ký tự, và cắt chuỗi rỗng đầu cuối chuỗi.
RemoveDups(rng, "", TRUE,TRUE)
----------------

ndu96081631 · 4/9/20

HeSanbi đã viết:
Thêm hai tham số tùy chọn, phân biệt hoa thường với ký tự

Nhắc mới nhớ nha
Lúc đầu viết code tôi có nghĩ tới, xong loay hoay lát tự dưng quên luôn. Cảm ơn bạn
-----------------------------

HeSanbi đã viết:
Tôi chuẩn hóa lại giúp bạn để tiện dụng hơn. Bạn có thể tham khảo thêm ADODB để xử lý dữ liệu lớn.

Nghe đồn rằng ADO chỉ làm việc được với dữ liệu nhỏ hơn 65536 dòng, điều đó có đúng không?

huhumalu · 4/9/20

ndu96081631 đã viết:
Nhắc mới nhớ nha
Lúc đầu viết code tôi có nghĩ tới, xong loay hoay lát tự dưng quên luôn. Cảm ơn bạn
-----------------------------

Nghe đồn rằng ADO chỉ làm việc được với dữ liệu nhỏ hơn 65536 dòng, điều đó có đúng không?

Không đúng đâu anh, em làm với khối dữ liệu lớn, thậm chí excel định dạng .xls kg chứa nổi nhưng ADO vẫn xử tốt, sau phải lưu sang .xlsm để tăng số dòng lên.
em dùng Microsoft.ACE.OLEDB.12.0 đưa dữ liệu từ Access vào.
Nếu dùng Excel thì chắc nó giới hạn giống như chính số dòng của bảng thôi anh.

HieuCD · 4/9/20

ndu96081631 đã viết:
Nhắc mới nhớ nha
Lúc đầu viết code tôi có nghĩ tới, xong loay hoay lát tự dưng quên luôn. Cảm ơn bạn
-----------------------------

Nghe đồn rằng ADO chỉ làm việc được với dữ liệu nhỏ hơn 65536 dòng, điều đó có đúng không?

Bỏ qua lệnh Set như
Set rs = cn.Execute(sqlStr)
Chỉ lấy được nhỏ hơn 65536 dòng

huhumalu · 7/9/20

ndu96081631 đã viết:
Nhắc mới nhớ nha
Lúc đầu viết code tôi có nghĩ tới, xong loay hoay lát tự dưng quên luôn. Cảm ơn bạn
-----------------------------

Nghe đồn rằng ADO chỉ làm việc được với dữ liệu nhỏ hơn 65536 dòng, điều đó có đúng không?

Có thể em hiểu sai ý của các anh.
Em đang để dữ liệu tại ô A1 và A100000
Dùng ADODB.Recordset lấy dữ liệu và paste qua Sheet"Data_XuLy". Vẫn dùng ngon lành.

Ngô Hải Đăng · 10/11/20

Nếu đã đánh dấu vị trí trong Dic thì sao không tận dụng Index để gán kết quả. Đặt Key theo cách của mình thì có thể lấy luôn ô trống và ô bị lỗi. Mọi người test thử nhé.

Mã:

Function UniqueArray(iArray, iColumns)
  Dim tmpArr, rowIdx(), colIdx()
  Dim x&, y&, sKey$
 
  tmpArr = Application.Index(iArray, 0, 0)
  If IsArray(iColumns) Then
    colIdx = Application.Index(iColumns, 1, 0)
  Else
    ReDim colIdx(1 To 1): colIdx(1) = iColumns
  End If
 
  With CreateObject("Scripting.Dictionary")
    .CompareMode = TextCompare
    For x = 1 To UBound(tmpArr)
      sKey = vbNullString
      For y = 1 To UBound(colIdx)
        sKey = sKey & TypeName(tmpArr(x, colIdx(y))) & CStr(tmpArr(x, colIdx(y)))
      Next y
      If Not .Exists(sKey) Then .Add sKey, x
    Next x
    rowIdx = Application.Transpose(.Items)
  End With
 
  colIdx = Application.Index(tmpArr, 1, 0)
  For x = 1 To UBound(colIdx)
    colIdx(x) = x
  Next x
  UniqueArray = Application.Index(tmpArr, rowIdx, colIdx)
End Function

Lọc dữ liệu trùng mảng 2 chiều dùng Dictionary (1 người xem)

Người dùng đang xem chủ đề này

Thành viên tích cực

File đính kèm

Huyền thoại GPE

File đính kèm

Chuyên gia GPE

File đính kèm

Thành viên tiêu biểu

Thành viên tích cực

Huyền thoại GPE

Thành viên tiêu biểu

Coming back ...

Huyền thoại GPE

Coming back ...

Huyền thoại GPE

Thành viên tiêu biểu

Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨

File đính kèm

Huyền thoại GPE

Thành viên tích cực

Chuyên gia GPE

Thành viên tích cực

File đính kèm

Thành viên hoạt động

Đếm ngược thời gian