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

  • Thread starter Thread starter huhumalu
  • Ngày gửi Ngày gửi
Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
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 à
Nhấp chuột vào đây để mở rộng...
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.
 

File đính kèm

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.
Nhấp chuột vào đây để mở rộng...
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
 

File đính kèm

Lần chỉnh sửa cuối:
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
Nhấp chuột vào đây để mở rộng...
Thử lệnh
a = RemoveDups([a2:b4], Array(1, 3))
bị lổi
Bài đã được tự động gộp:

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
Nhấp chuột vào đây để mở rộng...
Tùy quan điểm mỗi người, theo mình nên lấy dòng tô vàng trong file
 

File đính kèm

Lần chỉnh sửa cuối:
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
Nhấp chuột vào đây để mở rộng...
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 !
 
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
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh ndu96081631 rất nhiều. Code chạy ngon lành ạ.
 
HieuCD đã viết:
Thử lệnh
a = RemoveDups([a2:b4], Array(1, 3))
bị lổi
Nhấp chuột vào đây để mở rộng...
Đú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 !
Nhấp chuột vào đây để mở rộng...
Bạn cho ví dụ cụ thể xem, tôi chưa hiểu lắm
 
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
Nhấp chuột vào đây để mở rộng...
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 ạ!
 
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
Nhấp chuột vào đây để mở rộng...
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.
 
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.
Nhấp chuột vào đây để mở rộ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
 
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
Nhấp chuột vào đây để mở rộng...
Trong hàm thì ta nên thay
MsgBox Err.Description
Thành

RemoveDups=Err.Description
 
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 ạ!
Nhấp chuột vào đây để mở rộng...
Đang suy nghĩ bài của bạn liệu có thể dùng Advanced Filter được không?
 
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)
----------------
 

File đính kèm

HeSanbi đã viết:
Thêm hai tham số tùy chọn, phân biệt hoa thường với ký tự
Nhấp chuột vào đây để mở rộng...
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.
Nhấp chuột vào đây để mở rộng...
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?
 
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?
Nhấp chuột vào đây để mở rộ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.
 
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?
Nhấp chuột vào đây để mở rộng...

Bỏ qua lệnh Set như
Set rs = cn.Execute(sqlStr)
Chỉ lấy được nhỏ hơn 65536 dòng
 
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?
Nhấp chuột vào đây để mở rộ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.
 

File đính kèm

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
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

G
Xin Code xóa Module. (6 người xem)
Trả lời
2
Đọc
52
Hoàng Tuấn 868
H
L
Lỗi font khi convert từ pdf (3 người xem)
Trả lời
3
Đọc
107
lamvu0677
L
N
Khắc phục lỗi "The picture is too large and will be truncated" (2 người xem)
Trả lời
9
Đọc
5K
SonBDND
S
GPE-Trợ Lý
[GPE] TALKSHOW: PHÂN TÍCH BÁO CÁO ĐỘ NHẠY SỬ DỤNG EXCEL SOLVER (3 người xem)
Trả lời
0
Đọc
52
GPE-Trợ Lý
GPE-Trợ Lý
D
  • Question Question
Quản lý email outlook qua VBA cần giúp đỡ (5 người xem)
Trả lời
10
Đọc
172
nguyendang95
N
K
  • Question Question
nhờ ace giúp đỡ tự động filter và In hàng loạt từng mục trong piviot table (2 người xem)
Trả lời
1
Đọc
80
khkkh
K
K
Xin dax tính tỷ trọng doanh thu
Trả lời
18
Đọc
754
SteveNguyen1991
S
F
  • Question Question
Tự động Merge Mail bằng VBA
Trả lời
6
Đọc
182
Hoàng Tuấn 868
H
N
Một ví dụ về XLL add-in: Tương tác với Google Gemini dưới dạng công thức bảng tính (2 người xem)
    • Thích
Trả lời
0
Đọc
85
nguyendang95
N
H
Nhờ anh/chị giúp đỡ em viết công thức trừ dữ liệu theo FiFo (1 người xem)
Trả lời
1
Đọc
96
HieuCD
H
BNTT
LockXLS - Chương trình bảo vệ an toàn cho các file bảng tính Excel (1 người xem)
    • Thích
4 5 6
Trả lời
118
Đọc
73K
YêuCN
Y
vsitcnh
Hỗ trợ công thức tính điểm dựa theo điều kiện. (1 người xem)
Trả lời
14
Đọc
193
thuytrangbp28
T
micam111
  • Question Question
Cách chạy nhiều đồng hồ đếm giờ trong VBA
Trả lời
4
Đọc
690
thuytrangbp28
T
B
Xin giải pháp chống sửa, xóa dữ liệu đã nhập vào từ ngày hôm trước.
    • Thích
2
Trả lời
26
Đọc
7K
Tuấn Bụng Bự
Tuấn Bụng Bự
Emyeuexcel
  • Question Question
In tất cả các file trong cùng 1 thư mục
Trả lời
3
Đọc
207
Hoàng Tuấn 868
H
1
Hỏi về đánh dấu hàng ngang hàng dọc bằng màu khi kích chuột vào 1 ô
Trả lời
7
Đọc
200
Gà Công Nghệ
Gà Công Nghệ
PhanTuHuong
Sách Lập trình VBA trong AutoCAD đã có mặt
    • Thích
    • Yêu thích
2
Trả lời
20
Đọc
1K
Mr.hieudoanxd
Mr.hieudoanxd
P
Excell code vba : Tìm Cell để sửa dữ liệu (1 người xem)
    • Buồn
2
Trả lời
26
Đọc
578
Phạm Trường 80
P
D
Nhờ anh em giúp đỡ.
    • Buồn
Trả lời
2
Đọc
93
SA_DQ
SA_DQ
00029591
Cần hỗ trợ công thức tổng hợp dữ liệu không cần cột phụ Vlookup
Trả lời
2
Đọc
102
DeTong
D
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALK SHOW: CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
Back
Top Bottom