Các câu hỏi về mảng trong VBA (Array)

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

viehoai

Thành viên gắn bó
Tham gia
22/5/09
Bài viết
2,599
Được thích
2,908
Xin các anh chị giúp đỡ Code Gán các giá trị của một Range là các phần tử của Mãng
Ví dụ: Tôi có các giá trị của Range("A1:A10"). Tôi muốn viết code để gán giá trị của các cells từ A1:A10 là các phần tử của Mãng Arr chẳn hạn.
Xin cảm ơn các anh chị
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Nói về text, value, format, formula thì nên tự tìm hiểu, sau đây là 1 cách tự tìm hiểu:

1546320241021.png
 
Upvote 0
Nhắc nhở cho cái cô bé kia kẻo lỡ cơ hội.
Vấn đề mảng nói chung, và mảng nhiều chiều nói riêng, ở đây KHÔNG CÓ ai giỏi bằng bác ấy. Lời nhận định này không có ngoại lệ, tức là kể cả tôi cũng nhường bác ấy.

Cô bé phải nhân cơ hội này mà hỏi bác ấy cách duyệt mảng 2 chiều. Và nhờ bác ấy giải thích.

Chú: đối với tôi thì viết code rõ, dễ đọc mới là tối ưu. Nhưng đối với các bạn, tốc độ mới quan trọng. Duyệt mảng có cách tốc độ ưu việt hơn cách khác khi ta hiểu rõ cấu trúc của nó.
 
Upvote 0
Dạ, cháu cảm ơn chú Mỹ đã chỉ dẫn để cháu hiểu thêm về bản chất các thuộc tính của range ạ.
Cháu cảm ơn bác VetMini đã chỉ đường ạ, cháu cũng thường hỏi bác ấy nhiều,nhưng đầu óc cháu hay quên và tư duy kém linh hoạt nên mới hay hỏi ạ...vâng, khi có cơ hội cháu sẽ cố gắng hỏi bác ấy nhiều hơn nữa ạ.
Thực sự vấn đề này cháu chưa biết và hình dung được bác ạ:
... phải nhân cơ hội này mà hỏi bác ấy cách duyệt mảng 2 chiều.Và nhờ bác ấy giải thích...
Nhấp chuột vào đây để mở rộng...
Híc... T_T
 
Upvote 0
batman1 đã viết:
Với một bài như thế này mà mọi người lao vào giải thì tôi cũng thấy lạ.

Muốn giải một bài Toán thì phải biết giả thiết của nó. Ngay cả những định lý Toán không phải bao giờ cũng đúng, hầu như không bao giờ đúng cho mọi trường hợp. Vì thế luôn có vd.: "Nếu hàm f(x) liên tục và có đạo hàm trong đoạn ... thì ...". Tức cái định lý đó chỉ đúng khi hàm f(x) liên tục và có đạo hàm trong đoạn ...

Nhưng không có định nghĩa, thế nào là khác nhau, thế nào là như nhau.

Chưa biết khái niệm "khác nhau", "như nhau" mà đã lao vào giải thì hơi lạ. Tôi thường rất khó tính, phải cho tôi tiêu chuẩn thì tôi mới so sánh. Không có "thước đo" thì làm sao "đo" 2 "thực thể" để so sánh được?

Sau một loạt bài tôi hiểu là nếu sheet1!A1 = 1 (số), sheet1!A1 = 1 (ô được định dạng là text sau đó nhập 1) thì bạn coi là khác nhau vì bạn viết


Bây giờ ta xét trường hợp:
- sheet1: A1 = 5
- sheet2: A1 =SUM(A2:A3), A2 = 3, A3 = 2

Code của Ba Tê trả về TRUE, tức 2 ô bạn cho là giống nhau? 1 (số) <> 1 (text) thì cho là 2 ô khác nhau mà trong trường hợp này 2 ô lại như nhau? Vì bản chất 2 ô khác nhau rất nhiều. Một ô chứa hằng sồ, còn ô kia giá trị có thể thay đổi. Sau một nháy mắt sheet2!A3 có thể <> 2 do người dùng thay đổi A3, hoặc vd. A3 chứa công thức tham chiếu tới vd. C2 và người dùng thay đổi C2. Lúc này cả 2 A1 không còn giống nhau mặc dù ta không thay đổi trực tiếp 2 A1.

Có lẽ chính vì để phát hiện trường hợp này mà người ta dùng FormulaLocal thay cho Value?

Nếu bạn muốn người ta làm chính xác với mong đợi của mình thì bạn phải định nghĩa khái niệm "giống nhau" hoặc "khác nhau". Trừ phi bạn chưa nghĩ thấu đáo, khi nào thì coi là như nhau và khi nào thì coi là khác nhau.
Nhấp chuột vào đây để mở rộng...
Có gì mà lạ bác, mọi người toàn vội vàng sống gấp, suy nghĩ nhanh, code cũng muốn code nhanh dù chẳng hơn nhau mấy % giây (tức là hiệu quả gần như bằng 0)
File dữ liệu người hỏi thì ẩu từ cách làm file data - thì kết quả sẽ đa dạng thôi.
 
Lần chỉnh sửa cuối:
Upvote 0
tam888 đã viết:
Có gì mà lạ bác, mọi người toàn vội vàng sống gấp, suy nghĩ nhanh, code cũng muốn code nhanh dù chẳng hơn nhau mấy % giây (tức là hiệu quả gần như bằng 0)
...
Nhấp chuột vào đây để mở rộng...
Tôi không tin lắm.
Theo tôi thì chỉ vì một vài vị có máu mặt trong diễn đàn này chú trọng "tốc độ chạy của code" cho nên những người học code theo họ cứ nghĩ rằng đấy là chân lý của lập trình ứng dụng.
Đọc bài quen ở đây sẽ thấy "trường phái GPE" sắp hạng những điều được coi là "tối ưu code":
1. tốc độ chạy
2. số dòng code
3. số vòng lặp
 
Upvote 0
Xin chào các bạn,
Oanh Thơ đang sử dụng hàm "RemoveDupesDict" để xóa các các dữ liệu trùng:
Mã: 
Function RemoveDupesDict(MyArray As Variant) As Variant
'   SOURCE: https://wellsr.com
    Dim i As Long, Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        For i = LBound(MyArray) To UBound(MyArray)
            If IsMissing(MyArray(i)) = False Then
                .Item(MyArray(i)) = 1
            End If
        Next
        RemoveDupesDict = .Keys
    End With
End Function

Và 1 sub Test_RemoveDupesDict
Mã: 
Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
  
    arr1 = sh.Range("A1:R1").Value
    arr2 = RemoveDupesDict(Application.Transpose(Application.Transpose(arr1)))
    sh.Range("A2").Resize(, UBound(arr2)) = arr2
  
    arr1 = sh.Range("A4:A20").Value
    arr2 = RemoveDupesDict(Application.Transpose(arr1))
    sh.Range("B4").Resize(UBound(arr2)) = arr2

End Sub

Nhờ các bạn sửa giúp hàm "RemoveDupesDict" để không phải sử dụng đến các hàm hỗ trợ "Application.Transpose", kết quả mong muốn hàm sau khi sửa sẽ viết như sau:
Mã: 
Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
  
    arr1 = sh.Range("A1:R1").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("A2").Resize(, UBound(arr2)) = arr2
  
    arr1 = sh.Range("A4:A20").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("B4").Resize(UBound(arr2)+1) = arr2

    arr1 = sh.Range("D6:E22").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("I6").Resize(UBound(arr2)+1, 2) = arr2
End Sub
Untitled.jpg
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào các bạn,
Oanh Thơ đang sử dụng hàm "RemoveDupesDict" để xóa các các dữ liệu trùng:
Mã: 
Function RemoveDupesDict(MyArray As Variant) As Variant
'   SOURCE: https://wellsr.com
    Dim i As Long, Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        For i = LBound(MyArray) To UBound(MyArray)
            If IsMissing(MyArray(i)) = False Then
                .Item(MyArray(i)) = 1
            End If
        Next
        RemoveDupesDict = .Keys
    End With
End Function

Và 1 sub Test_RemoveDupesDict
Mã: 
Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
 
    arr1 = sh.Range("A1:R1").Value
    arr2 = RemoveDupesDict(Application.Transpose(Application.Transpose(arr1)))
    sh.Range("A2").Resize(, UBound(arr2)) = arr2
 
    arr1 = sh.Range("A4:A20").Value
    arr2 = RemoveDupesDict(Application.Transpose(arr1))
    sh.Range("B4").Resize(UBound(arr2)) = arr2

End Sub

Nhờ các bạn sửa giúp hàm "RemoveDupesDict" để không phải sử dụng đến các hàm hỗ trợ "Application.Transpose", kết quả mong muốn hàm sau khi sửa sẽ viết như sau:
Mã: 
Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
 
    arr1 = sh.Range("A1:R1").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("A2").Resize(, UBound(arr2)) = arr2
 
    arr1 = sh.Range("A4:A20").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("B4").Resize(UBound(arr2)+1) = arr2

    arr1 = sh.Range("D6:E22").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("I6").Resize(UBound(arr2)+1, 2) = arr2
End Sub
View attachment 210577
Nhấp chuột vào đây để mở rộng...
Bạn dùng cái này xem.
Mã: 
Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
    arr1 = sh.Range("d6:e22").Value
    arr2 = RemoveDupesDict(arr1, 1)
    sh.Range("i6").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
End Sub
Function RemoveDupesDict(MyArray As Variant, Optional ByVal so = 1) As Variant
    Dim arr, a As Integer, j As Long
    ReDim arr(1 To UBound(MyArray, 1), 1 To UBound(MyArray, 2))
'   SOURCE: https://wellsr.com
    Dim i As Long, Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        For i = LBound(MyArray, 1) To UBound(MyArray, 1)
            If Not .exists(MyArray(i, so)) Then
                 a = a + 1
                 For j = 1 To UBound(MyArray, 2)
                     arr(a, j) = MyArray(i, j)
                 Next j
                .Item(MyArray(i, so)) = 1
            End If
        Next
        RemoveDupesDict = arr
    End With
End Function
 
Upvote 0
snow25 đã viết:
Bạn dùng cái này xem.
Mã: 
Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
    arr1 = sh.Range("d6:e22").Value
    arr2 = RemoveDupesDict(arr1, 1)
    sh.Range("i6").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
End Sub
Function RemoveDupesDict(MyArray As Variant, Optional ByVal so = 1) As Variant
    Dim arr, a As Integer, j As Long
    ReDim arr(1 To UBound(MyArray, 1), 1 To UBound(MyArray, 2))
'   SOURCE: https://wellsr.com
    Dim i As Long, Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        For i = LBound(MyArray, 1) To UBound(MyArray, 1)
            If Not .exists(MyArray(i, so)) Then
                 a = a + 1
                 For j = 1 To UBound(MyArray, 2)
                     arr(a, j) = MyArray(i, j)
                 Next j
                .Item(MyArray(i, so)) = 1
            End If
        Next
        RemoveDupesDict = arr
    End With
End Function
Nhấp chuột vào đây để mở rộng...

Xin chào snow25
Cảm ơn bạn nhiều,OT test thử 3 trường hợp như sau:
Mã: 
Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
'1:
    arr1 = sh.Range("A1:Q1").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("A2").Resize(, UBound(arr2)) = arr2 'chỉ trả về được 1 phần tử trong arr2
'2:
    arr1 = sh.Range("A4:A20").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("B4").Resize(UBound(arr2)) = arr2
'3:    
    arr1 = sh.Range("d6:e22").Value
    arr2 = RemoveDupesDict(arr1, 1)
    sh.Range("i6").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
End Sub

2, trường hợp thì OK, còn đầu tiên trường hợp:
Mã: 
    arr1 = sh.Range("A1:Q1").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("A2").Resize(, UBound(arr2)) = arr2 'chỉ trả về được 1 phần tử trong arr2

Nhờ bạn xem giúp ạ.
 
Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào snow25
Cảm ơn bạn nhiều,OT test thử 3 trường hợp như sau:
Mã: 
Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
'1:
    arr1 = sh.Range("A1:Q1").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("A2").Resize(, UBound(arr2)) = arr2 'chỉ trả về được 1 phần tử trong arr2
'2:
    arr1 = sh.Range("A4:A20").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("B4").Resize(UBound(arr2)) = arr2
'3: 
    arr1 = sh.Range("d6:e22").Value
    arr2 = RemoveDupesDict(arr1, 1)
    sh.Range("i6").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
End Sub

2, trường hợp thì OK, còn đầu tiên trường hợp:
Mã: 
    arr1 = sh.Range("A1:Q1").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("A2").Resize(, UBound(arr2)) = arr2 'chỉ trả về được 1 phần tử trong arr2

Nhờ bạn xem giúp ạ.
Nhấp chuột vào đây để mở rộng...
Cái hàm
Function RemoveDupesDict(MyArray As Variant, Optional ByVal so = 1) As Variant và If Not .exists(MyArray(i, so)) Then vì vậy arr1 = sh.Range("A1:Q1").Value thì sh.Range("A2").Resize(, UBound(arr2)) = arr2 trả về kết quả là A1 là đúng rồi ;)
Đáng nhẽ phải là UBound(arr2,2) chứ
 
Lần chỉnh sửa cuối:
Upvote 0
Cái hàm RemoveDupesDict này lấy ở đâu ra vậy? Theo notes thì nó lấy của wellsr.com, có chính xác vậy không?
 
Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào snow25
Cảm ơn bạn nhiều,OT test thử 3 trường hợp như sau:
Mã: 
Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
'1:
    arr1 = sh.Range("A1:Q1").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("A2").Resize(, UBound(arr2)) = arr2 'chỉ trả về được 1 phần tử trong arr2
'2:
    arr1 = sh.Range("A4:A20").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("B4").Resize(UBound(arr2)) = arr2
'3:   
    arr1 = sh.Range("d6:e22").Value
    arr2 = RemoveDupesDict(arr1, 1)
    sh.Range("i6").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
End Sub

2, trường hợp thì OK, còn đầu tiên trường hợp:
Mã: 
    arr1 = sh.Range("A1:Q1").Value
    arr2 = RemoveDupesDict(arr1)
    sh.Range("A2").Resize(, UBound(arr2)) = arr2 'chỉ trả về được 1 phần tử trong arr2

Nhờ bạn xem giúp ạ.
Nhấp chuột vào đây để mở rộng...
Mã: 
Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
    arr1 = sh.Range("a1:q1").Value
    arr2 = RemoveDupesDict(arr1, 1, 2)
    sh.Range("i6").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
End Sub
Function RemoveDupesDict(MyArray As Variant, Optional ByVal so = 1, Optional ByVal dk = 1) As Variant
    Dim arr, a As Integer, j As Long
'   SOURCE: https://wellsr.com
    Dim i As Long, Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
      Select Case dk
      Case 1
        ReDim arr(1 To UBound(MyArray, 1), 1 To UBound(MyArray, 2))
        For i = LBound(MyArray, 1) To UBound(MyArray, 1)
            If Not .exists(MyArray(i, so)) Then
                 a = a + 1
                 For j = 1 To UBound(MyArray, 2)
                     arr(a, j) = MyArray(i, j)
                 Next j
                .Item(MyArray(i, so)) = 1
            End If
        Next
      Case 2
         ReDim arr(1 To UBound(MyArray, 2), 1 To UBound(MyArray, 1))
         For i = LBound(MyArray, 2) To UBound(MyArray, 2)
            If Not .exists(MyArray(1, i)) Then
                 a = a + 1
                 arr(a, 1) = MyArray(1, i)
                .Item(MyArray(1, i)) = 1
            End If
        Next
      End Select
        RemoveDupesDict = arr
    End With
End Function
Bạn test cái này xem.
 
Upvote 0
VetMini đã viết:
Cái hàm RemoveDupesDict này lấy ở đâu ra vậy? Theo notes thì nó lấy của wellsr.com, có chính xác vậy không?
Nhấp chuột vào đây để mở rộng...
Xin chào bác VetMini.
Dạ, cháu lấy ở đây bác ạ:
https://wellsr.com/vba/2017/excel/vba-remove-duplicates-from-array/

PacificPR đã viết:
Với mảng trên UBound(arr2) =1 mờ. Nếu mảng 1 hàng thì hàm trên trả nguyên về mảng ban đầu
Nhấp chuột vào đây để mở rộng...

OT Debug thấy đúng như vậy :), PacificPR sửa hàm RemoveDupesDict đi ạ.
 
Upvote 0
Tôi đặt câu hỏi là vì từ "dupe" tiếng Anh có nghĩa là "gạt" (động) và "gã khờ" (danh).
Đang tìm hiểu xem tại sao tác giả lại chơi chữ lạ vậy.

Bổ sung:
Đã tìm ra rồi. "dupes" là âm đọc tắt của "dupplicates". (Chỉ là âm chứ không phải từ chính thức, cũng như cos là because)
 
Lần chỉnh sửa cuối:
Upvote 0
snow25 đã viết:
Mã: 
Sub Test_RemoveDupesDict()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
    arr1 = sh.Range("a1:q1").Value
    arr2 = RemoveDupesDict(arr1, 1, 2)
    sh.Range("i6").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
End Sub
Function RemoveDupesDict(MyArray As Variant, Optional ByVal so = 1, Optional ByVal dk = 1) As Variant
    Dim arr, a As Integer, j As Long
'   SOURCE: https://wellsr.com
    Dim i As Long, Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
      Select Case dk
      Case 1
        ReDim arr(1 To UBound(MyArray, 1), 1 To UBound(MyArray, 2))
        For i = LBound(MyArray, 1) To UBound(MyArray, 1)
            If Not .exists(MyArray(i, so)) Then
                 a = a + 1
                 For j = 1 To UBound(MyArray, 2)
                     arr(a, j) = MyArray(i, j)
                 Next j
                .Item(MyArray(i, so)) = 1
            End If
        Next
      Case 2
         ReDim arr(1 To UBound(MyArray, 2), 1 To UBound(MyArray, 1))
         For i = LBound(MyArray, 2) To UBound(MyArray, 2)
            If Not .exists(MyArray(1, i)) Then
                 a = a + 1
                 arr(a, 1) = MyArray(1, i)
                .Item(MyArray(1, i)) = 1
            End If
        Next
      End Select
        RemoveDupesDict = arr
    End With
End Function
Bạn test cái này xem.
Nhấp chuột vào đây để mở rộng...

Cảm ơn snow25 nhiều ạ,
Bạn có thể sửa giúp OT trong trường hợp, nếu dk=2 khi muốn đưa các phần tử trong mảng vào 1 dòng , thì không phải sử dụng "Application.Transpose" nữa được không ạ:
Mã: 
arr2 = RemoveDupesDict2(arr1, 1, 2)
    sh.Range("A2").Resize(, UBound(arr2)) = Application.Transpose(arr2)
 
Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
Cảm ơn snow25 nhiều ạ,
Bạn có thể sửa giúp OT trong trường hợp, nếu dk=2 khi muốn đưa các phần tử trong mảng vào 1 dòng , thì không phải sử dụng "Application.Transpose" nữa được không ạ:
Mã: 
arr2 = RemoveDupesDict2(arr1, 1, 2)
    sh.Range("A2").Resize(, UBound(arr2)) = Application.Transpose(arr2)
Nhấp chuột vào đây để mở rộng...

Hihi, loay hoay một lúc với cái Case 2 hình như OK rồi. Xin cảm ơn snow25 nhiều ạ.
OT gửi lại code, nếu có chỗ nào chưa tối ưu (có thể phát sinh lỗi) nhờ các bạn góp ý thêm ạ:
Mã: 
Option Explicit

Sub Test_RemoveDupesDict_2()
    Dim arr1() As Variant, arr2() As Variant
    Dim sh As Worksheet: Set sh = ThisWorkbook.Worksheets("Sheet1")
'1:
    arr1 = sh.Range("A1:Q1").Value
    arr2 = RemoveDupesDict_2(arr1, 1, 2)
    sh.Range("A2").Resize(, UBound(arr2)) = arr2

    
'2:
    arr1 = sh.Range("A4:A20").Value
    arr2 = RemoveDupesDict_2(arr1)
    sh.Range("B4").Resize(UBound(arr2)) = arr2
    
'3:
    arr1 = sh.Range("D6:E22").Value
    arr2 = RemoveDupesDict_2(arr1, 1)
    sh.Range("I6").Resize(UBound(arr2, 1), UBound(arr2, 2)) = arr2
    
End Sub

Function RemoveDupesDict_2(MyArray As Variant, Optional ByVal so = 1, Optional ByVal dk = 1) As Variant
    Dim arr, a As Integer, j As Long
'   SOURCE: https://wellsr.com
    Dim i As Long, Dic As Object
    Set Dic = CreateObject("Scripting.Dictionary")
    With Dic
        Select Case dk
        Case 1
            ReDim arr(1 To UBound(MyArray, 1), 1 To UBound(MyArray, 2))
            For i = LBound(MyArray, 1) To UBound(MyArray, 1)
                If Not .exists(MyArray(i, so)) Then
                     a = a + 1
                     For j = 1 To UBound(MyArray, 2)
                         arr(a, j) = MyArray(i, j)
                     Next j
                    .Item(MyArray(i, so)) = 1
                End If
            Next i
        Case 2
        ReDim arr(1 To UBound(MyArray, 2))
        For i = LBound(MyArray, 2) To UBound(MyArray, 2)
            If Not .exists(MyArray(1, i)) Then
                 a = a + 1
                 arr(a) = MyArray(1, i)
                .Item(MyArray(1, i)) = 1
            End If
        Next i
        End Select
        RemoveDupesDict_2 = arr
    End With
End Function
 
Upvote 0
Xin chào snow25,
Bạn có thể giải thích thêm tham số Optional ByVal so = 1, trong:
Function RemoveDupesDict(MyArray As Variant, Optional ByVal so = 1, Optional ByVal dk = 1) As Variant
Nhấp chuột vào đây để mở rộng...
Có tác dụng gì thế ạ?
If Not .exists(MyArray(i, so)) Then

OT thử thay thẳng số 1 vào:
If Not .exists(MyArray(i, 1)) Then
và sửa thành:
Function RemoveDupesDict(MyArray As Variant, Optional ByVal dk = 1) As Variant
Nhấp chuột vào đây để mở rộng...
Thì code không có lỗi gì.
Như vậy cái "Optional ByVal so=1" dùng để lựa chọn trong trường hợp đặc biệt nào vậy ạ?
 
Upvote 0
Nguyễn Hoàng Oanh Thơ đã viết:
Xin chào snow25,
Bạn có thể giải thích thêm tham số Optional ByVal so = 1, trong:

Có tác dụng gì thế ạ?
If Not .exists(MyArray(i, so)) Then

OT thử thay thẳng số 1 vào:
If Not .exists(MyArray(i, 1)) Then
và sửa thành:

Thì code không có lỗi gì.
Như vậy cái "Optional ByVal so=1" dùng để lựa chọn trong trường hợp đặc biệt nào vậy ạ?
Nhấp chuột vào đây để mở rộng...
Đề nghị OanhTho phải đọc lại VBA từ Cơ bản
Tôi cảm thấy bạn học từ diễn đàn này lung tung quá - nói khác là học từ giữa ra hay cao xuống thì phải --- Nếu không phải thì bỏ qua, coi như tôi chưa viết.

So ở đây là tham số - bạn phải đọc code của họ thì sẽ hiểu so là gì --> so chính là thứ tự cột xét trùng (với code gốc bạn tham chiếu từ website của tây nhé) -- các codes sửa lại chỉnh lý sau thì tương tự, chỉ riêng với dk=2 thì lúc này so lại là thứ tự dòng (ở đây =1 luôn, vì họ chỉ xét mảng có một dòng A#:Q#)
Nên có thể người ta thích cột xét trùng là cột khác
Lưu ý hàm tẩy (remove ...:D ) trùng RemoveDupesDict ở đây chỉ xét 1 cột trùng của bảng MyArray
 
Lần chỉnh sửa cuối:
Upvote 0
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

X
Tự động giãn dòng và ẩn các dòng bị bỏ trống
Trả lời
2
Đọc
77
xuanthucle
X
A
  • Đã giải quyết
Xin giúp đỡ code VBA chép cột dữ liệu có điều kiện từ file này sang file khác
2 3
Trả lời
59
Đọc
3K
Hoàng Nhật Phương
Hoàng Nhật Phương
S
Tính trung bình của tháng đầu tiên.
Trả lời
3
Đọc
212
Phuocam
Phuocam
T
  • Question Question
Xin code VBA trả về tên tài khoản theo điều kiện
    • Chấp nhận
Trả lời
10
Đọc
210
DeTong
D
H
Nhờ các cao nhân chỉ giáo code file Form nhập liệu Google Sheet !!!
    • Thích
Trả lời
4
Đọc
85
befaint
befaint
hoamattroicoi
TỔNG HỢP TỜ KHAI THUẾ THEO THÔNG TƯ 80/2021 TỪ *.XML SANG EXCEL
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
7
Đọc
3K
Nguyễn Văn Thái 92
N
N
  • Question Question
Cần giúp rút gọn code vba
Trả lời
7
Đọc
176
DeTong
D
M
  • Question Question
Code VBA tìm mã kiện gỗ còn tồn kho
Trả lời
0
Đọc
44
moihocvba
M
dungdodac
Lỗi khi COPY , viền xung quanh ô được chọn đứng yên, không chạy
    • Cười
Trả lời
4
Đọc
202
VetMini
V
B
Xin hàm đếm số lượng khách hàng theo 1 điều kiện và bỏ dữ liệu trùng.
Trả lời
10
Đọc
369
Phan Thế Hiệp
Phan Thế Hiệp
Manhhung90
  • Question Question
Xin giúp chuyển dữ liệu từ cột dọc sang hàng ngang theo điều kiện
    • Cười
Trả lời
1
Đọc
50
Hoàng Tuấn 868
H
HeSanbi
  • Đã giải quyết
ExplorerXL - Quản lý thư mục với Excel: tìm, đổi tên, sao chép, di chuyển và xóa
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
79
Đọc
16K
viethung78
V
H
Giao diện mới ở "chế độ tối" mờ quá
    • Yêu thích
    • Thích
Trả lời
4
Đọc
140
OverAC
OverAC
J
quản lý dữ liệu theo cách quản lý bãi container
    • Thích
Trả lời
2
Đọc
7K
vunhai
V
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
13 14 15
Trả lời
298
Đọc
20K
ongke0711
ongke0711
M
Sắp xếp dữ liệu: Lọc tên theo ABC (alphabet) có lỗi tên Đam đứng trước Diệp
Trả lời
13
Đọc
5K
maidinhdung5
maidinhdung5
Nguyễn Duy Tuân
Hàm BS_FORMATTEXT Tạo công thức định dạng văn bản trong Excel với Add-in A-Tools v10
Trả lời
0
Đọc
42
Nguyễn Duy Tuân
Nguyễn Duy Tuân
Nguyễn Duy Tuân
Hàm BS_TEXT trộn văn bản trong Excel với Add-in A-Tools v10
Trả lời
0
Đọc
36
Nguyễn Duy Tuân
Nguyễn Duy Tuân
aduc
Nhật ký thi công bằng excel
    • Thích
2
Trả lời
36
Đọc
53K
PhanTuHuong
PhanTuHuong
likosin
xin cách lọc này với ạ.
Trả lời
4
Đọc
141
ptm0412
ptm0412
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
Chúc mừng năm mới
Back
Top Bottom