Nhờ lọc dữ liệu duy nhất từ 2 cột ra 1 cột khác bằng VBA (1 người xem)

Liên hệ QC

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

phihndhsp

Thành viên gạo cội
Tham gia
26/12/09
Bài viết
3,363
Được thích
2,488
Giới tính
Nam
Nghề nghiệp
Giáo Viên
Tối ưu là viết hẳn 1 hàm riêng để lọc Unique
PHP:
Function UniqueList(ParamArray sArray())
  Dim Item, tmpArr, SubArr
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
      tmpArr = SubArr
      If TypeName(tmpArr) <> "Variant()" Then
        If tmpArr <> "" Then .Add tmpArr, ""
      Else
        For Each Item In tmpArr
          If Item <> "" Then
            If Not .Exists(Item) Then .Add Item, ""
          End If
        Next
      End If
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function
PHP:
Sub Loc()
  Dim Arr, tmpArr, i As Long
  tmpArr = UniqueList(Sheet1.Range("A2:B60000"))
  Sheet2.Range("A:A").ClearContents
  If IsArray(tmpArr) Then
    ReDim Arr(1 To UBound(tmpArr) + 1, 1 To 1)
    For i = 0 To UBound(tmpArr)
      Arr(i + 1, 1) = tmpArr(i)
    Next
    Sheet2.Range("A1").Resize(i).Value = Arr
  End If
End Sub
Nói thêm: Hàm UniqueList này có khả năng lọc những vùng không nằm liên tục nhau đấy... Ví dụ:
Mã:
With Sheet1
    tmpArr = UniqueList(.[A2:A60000], .[E2:E60000], .[H2:H60000])
End With

PHP:
Sub Loc()
  Dim Arr, tmpArr, i As Long
  tmpArr = UniqueList(Sheet1.Range("A2:B60000"))
  Sheet2.Range("A:A").ClearContents
  If IsArray(tmpArr) Then
    ReDim Arr(1 To UBound(tmpArr) + 1, 1 To 1)
    For i = 0 To UBound(tmpArr)
      Arr(i + 1, 1) = tmpArr(i)
    Next
    Sheet2.Range("A1").Resize(i).Value = Arr
  End If
End Sub
sao em đổi tên Sheet1 và Sheet 2 thì nó báo lỗi
tmpArr = UniqueList(Sheet1.Range("A2:B60000"))
Sheet2.Range("A:A").ClearContents
anh giải thích dùm em 1 tí nha, cảm ơn anh nhiều chào anh


 
Sub Loc()
Dim Arr, tmpArr1, i As Long
tmpArr1
= UniqueList(Sheet1.Range("A2:B60000"))
Sheet2.Range("A:A").ClearContents
If IsArray(tmpArr1) Then
ReDim Arr
(1 To UBound(tmpArr1) + 1, 1 To 1)
For
i = 0 To UBound(tmpArr1)
Arr(i + 1, 1) = tmpArr1(i)
Next
Sheet2
.Range("A1").Resize(i).Value = Arr
End
If
End Sub
nếu em thay đổi tên sheet1 và sheet2 thì nó lại báo lỗi, em không hiểu tại sao. xin được anh giúp đỡ, có file đính kèm

 

File đính kèm

Upvote 0
Theo em hiểu thì sArray là Range nhưng khi khao báo sao lại là

PHP:
Function UniqueList(ParamArray sArray())

-----------------------
Em xin hỏi 2 cách viết sau có tương đương nhau không ah?

Cách 1:
PHP:
If IsArray(tmpArr) Then

Cách 2:
PHP:
If TypeName(TmpArr)="variant()" Then
 
Upvote 0
Theo em hiểu thì sArray là đối tượng Range sao khi khai báo nó lại là

PHP:
Function UniqueList(ParamArray sArray())
----------
Em xin hỏi thêm 2 cách viết
PHP:
If TypeName(tmpArr) = "Variant()" Then

PHP:
If isArray(tmpArr) Then

Có tương đương nhau không ah?
 
Upvote 0
Diễn đàn hôm nay làm sao ấy nhỉ? Em vào mãi mà không được.
 
Upvote 0
Em muốn lọc dữ liệu duy nhất của 2 cột A, B của Sheet 1 sang 1 cột A (sheet2).

Các bác giúp em với nhé.
 

File đính kèm

Upvote 0
Góp vui 1 cách lọc không dùng advancedfilter
Tại sheet1, bạn thử gõ số 11 vào A2 và số 1 vào B2 rồi test lại code của bạn xem kết quả thế nào nhé
- Thứ nhất: Dùng Find Method không phải là giải pháp tốt về tốc độ
- Thứ hai: Muốn dùng Find Method thì phải ghi rõ Find theo kiểu chính xác (xlWhole) mới xong
--------------
Ngoài ra xin góp ý thêm về cách viết code
- Khai báo biến nên rõ ràng
- Nếu như bạn khai bao biến theo kiểu Dim sh, r, n, dl, c thì thôi thà khỏi khai báo luôn cho khỏe
 
Lần chỉnh sửa cuối:
Upvote 0
Tại sheet1, bạn thử gõ số 11 vào A2 và số 1 vào B2 rồi test lại code của bạn xem kết quả thế nào nhé
- Thứ nhất: Dùng Find Method không phải là giải pháp tốt về tốc độ
- Thứ hai: Muốn dùng Find Method thì phải ghi rõ Find theo kiểu chính xác (xlWhole) mới xong
--------------
Ngoài ra xin góp ý thêm về cách viết code
- Khai báo biến nên rõ ràng
- Nếu như bạn khai bao biến theo kiểu Dim sh, r, n, dl, c thì thôi thà khỏi khai báo luôn cho khỏe

Cảm ơn anh đẫ sửa sai. Vì chưa hiểu rõ nên mới khai bảo như vậy. Nếu không viết sai thì sẽ không bao giờ có thể viết đúng.
Vậy khi khai báo mình phải tách như thế nào hả anh?
Nếu sửa lại thế này có ổn chưa vậy anh? Mong anh chỉ giúp.

Sub LOC()
Application.ScreenUpdating = 0
Dim sh As Worksheet
Dim r, n, c As Long
Dim dl As Range
Set sh = Sheets("sheet2")
sh.[A:A].Clear
n = [a65536].End(3).Row
For r = 2 To n
For c = 1 To 2
Set dl = sh.Range(sh.[a1], sh.[a65000].End(3)).Find(Cells(r, c), , , xlWhole)
If dl Is Nothing Then sh.[a65536].End(3).Offset(1) = Cells(r, c)
Next
Next
Application.ScreenUpdating = 1
End Sub
 
Upvote 0
Cảm ơn anh đẫ sửa sai. Vì chưa hiểu rõ nên mới khai bảo như vậy. Nếu không viết sai thì sẽ không bao giờ có thể viết đúng.
Vậy khi khai báo mình phải tách như thế nào hả anh?
Nếu sửa lại thế này có ổn chưa vậy anh? Mong anh chỉ giúp.

Sub LOC()
Application.ScreenUpdating = 0
Dim sh As Worksheet
Dim r, n, c As Long
Dim dl As Range
Set sh = Sheets("sheet2")
sh.[A:A].Clear
n = [a65536].End(3).Row
For r = 2 To n
For c = 1 To 2
Set dl = sh.Range(sh.[a1], sh.[a65000].End(3)).Find(Cells(r, c), , , xlWhole)
If dl Is Nothing Then sh.[a65536].End(3).Offset(1) = Cells(r, c)
Next
Next
Application.ScreenUpdating = 1
End Sub
Nếu viết theo kiểu Dim r, n, c As Long thì chỉ có biến c là Long thôi, các biến r, n là Variant
Vậy khai báo đúng là: Dim r as Long, n as Long, c as Long
 
Upvote 0
Dùng Dictionary thuật toán sẽ ngắn hơn

Bạn thử xem có được không nhé
PHP:
Sub Loc()
    Dim DL(), KQ(), i As Long, j As Long
    DL = Range([A2], [B100]).Value
    ReDim KQ(1 To 200, 1 To 1)
    Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(DL, 1)
        If DL(i, 1) <> "" And Not Dic.Exists(DL(i, 1)) Then
            Tmp = DL(i, 1)
            j = j + 1
            Dic.Add Tmp, j
            KQ(j, 1) = DL(i, 1)
        End If
        If DL(i, 2) <> "" And Not Dic.Exists(DL(i, 2)) Then
            Tmp = DL(i, 2)
            j = j + 1
            Dic.Add Tmp, j
            KQ(j, 1) = DL(i, 2)
        End If
    Next i
    Sheets("Sheet2").[A1].Resize(j) = KQ
End Sub

Nhưng có lẽ đó chưa phải là Code tối ưu nhờ mọi người góp ý thêm
 

File đính kèm

Upvote 0
Bạn thử xem có được không nhé
PHP:
Sub Loc()
    Dim DL(), KQ(), i As Long, j As Long
    DL = Range([A2], [B100]).Value
    ReDim KQ(1 To 200, 1 To 1)
    Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(DL, 1)
        If DL(i, 1) <> "" And Not Dic.Exists(DL(i, 1)) Then
            Tmp = DL(i, 1)
            j = j + 1
            Dic.Add Tmp, j
            KQ(j, 1) = DL(i, 1)
        End If
        If DL(i, 2) <> "" And Not Dic.Exists(DL(i, 2)) Then
            Tmp = DL(i, 2)
            j = j + 1
            Dic.Add Tmp, j
            KQ(j, 1) = DL(i, 2)
        End If
    Next i
    Sheets("Sheet2").[A1].Resize(j) = KQ
End Sub

Nhưng có lẽ đó chưa phải là Code tối ưu nhờ mọi người góp ý thêm
Tối ưu là viết hẳn 1 hàm riêng để lọc Unique
PHP:
Function UniqueList(ParamArray sArray())
  Dim Item, tmpArr, SubArr
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
      tmpArr = SubArr
      If TypeName(tmpArr) <> "Variant()" Then
        If tmpArr <> "" Then .Add tmpArr, ""
      Else
        For Each Item In tmpArr
          If Item <> "" Then
            If Not .Exists(Item) Then .Add Item, ""
          End If
        Next
      End If
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function
PHP:
Sub Loc()
  Dim Arr, tmpArr, i As Long
  tmpArr = UniqueList(Sheet1.Range("A2:B60000"))
  Sheet2.Range("A:A").ClearContents
  If IsArray(tmpArr) Then
    ReDim Arr(1 To UBound(tmpArr) + 1, 1 To 1)
    For i = 0 To UBound(tmpArr)
      Arr(i + 1, 1) = tmpArr(i)
    Next
    Sheet2.Range("A1").Resize(i).Value = Arr
  End If
End Sub
Nói thêm: Hàm UniqueList này có khả năng lọc những vùng không nằm liên tục nhau đấy... Ví dụ:
Mã:
With Sheet1
    tmpArr = UniqueList(.[A2:A60000], .[E2:E60000], .[H2:H60000])
End With
 
Upvote 0
Cách của thày Ndu mới quá, xin thày chỉ cho cách dùng của ParamArray với ah.
 
Upvote 0
Tối ưu là viết hẳn 1 hàm riêng để lọc Unique
PHP:
Function UniqueList(ParamArray sArray())
  Dim Item, tmpArr, SubArr
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
      tmpArr = SubArr
      If TypeName(tmpArr) <> "Variant()" Then
        If tmpArr <> "" Then .Add tmpArr, ""
      Else
        For Each Item In tmpArr
          If Item <> "" Then
            If Not .Exists(Item) Then .Add Item, ""
          End If
        Next
      End If
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function
PHP:
Sub Loc()
  Dim Arr, tmpArr, i As Long
  tmpArr = UniqueList(Sheet1.Range("A2:B60000"))
  Sheet2.Range("A:A").ClearContents
  If IsArray(tmpArr) Then
    ReDim Arr(1 To UBound(tmpArr) + 1, 1 To 1)
    For i = 0 To UBound(tmpArr)
      Arr(i + 1, 1) = tmpArr(i)
    Next
    Sheet2.Range("A1").Resize(i).Value = Arr
  End If
End Sub
Nói thêm: Hàm UniqueList này có khả năng lọc những vùng không nằm liên tục nhau đấy... Ví dụ:
Mã:
With Sheet1
    tmpArr = UniqueList(.[A2:A60000], .[E2:E60000], .[H2:H60000])
End With
Trong trường hợp dữ liệu 2 vùng khác nhau thì có thể dùng
PHP:
 tmpArr = UniqueList(Sheet1.Range("A2:A60000"), Sheet1.Range("c2:c60000"))
Vậy Sư Phụ cho em Hỏi
1. Số Vùng trong hàm UniqueList() có bị giới hạn không?
2. Áp dụng cách khai báo ParamArray sArray() như thế này thì có giải pháp giải bài #305 câu 2 này
Xin cảm ơn các anh chị (câu này em giải quyết được rồi)
 
Lần chỉnh sửa cuối:
Upvote 0
1. Số Vùng trong hàm UniqueList() có bị giới hạn không?
Tôi thật sự không biết ParamArray có giới hạn gì không nữa
2. Áp dụng cách khai báo ParamArray sArray() như thế này thì có giải pháp giải bài #305 câu 2 này
Xin cảm ơn các anh chị (câu này em giải quyết được rồi)
Bài của bạn tôi cũng có xem qua nhiều lần nhưng thật xin lỗi... Tôi chẳng hiểu tí gì
--------------------------
Tại sao lại phải sử dụng những 2 biến tmpArr;SubArr nhỉ (mặc dù chúng bằng nhau mà?)
SubArr lấy từ nguồn dữ liệu ra... ta không chắc nó thuộc biến gì (có thể là Range cũng có thể là Array)... Nhưng bằng cách gán tmpArr = SubArr thì chắc chắn tmpArr sẽ là mảng (ít nhất nó cũng không thể là Range)
Vậy đấy! ---> Đây thuộc về kinh nghiệm, làm hoài tự nhiên ngộ ra chân lý!
Ẹc... Ẹc...
 
Lần chỉnh sửa cuối:
Upvote 0
SubArr lấy từ nguồn dữ liệu ra... ta không chắc nó thuộc biến gì (có thể là Range cũng có thể là Array)... Nhưng bằng cách gán tmpArr = SubArr thì chắc chắn tmpArr sẽ là mảng (ít nhất nó cũng không thể là Range)

Chính em cũng đang rất gà mờ về vẫn đề này, trong Excel thì em biết kiểm tra phần biệt giữa Number và Text...nhưng trong VBA em không biết làm thế nào (dùng câu lệnh gì) để phân biệt:

- Nguồn dữ liệu là Range hay là mảng (variant)
- Dữ liệu đó là số hay Text.

Rất mong được thày chỉ bảo thêm.
 
Upvote 0
Chính em cũng đang rất gà mờ về vẫn đề này, trong Excel thì em biết kiểm tra phần biệt giữa Number và Text...nhưng trong VBA em không biết làm thế nào (dùng câu lệnh gì) để phân biệt:

- Nguồn dữ liệu là Range hay là mảng (variant)
- Dữ liệu đó là số hay Text.

Rất mong được thày chỉ bảo thêm.
Dùng TypeName để kiểm tra, ví dụ:
PHP:
Sub Test()
  Dim Rng
  Set Rng = Range("A1:C3")
  MsgBox TypeName(Rng)
End Sub
Dim Rng ---> Lúc đầu khai báo Rng chung chung, chưa biết nó là kiểu gì
Set Rng = Range("A1:C3") ---> Gán Range("A1:C3") vào biến Rng
TypeName(Rng) ---> Kiểm tra xem Rng là biến gì
-------------
Thử xem
 
Upvote 0
Phương pháp giải bài toán theo kiểu truyền tham số còn rất mới mẻ với em. Em hiểu:

SubArr có phải là cột A trong mảng "A2:B60000"?
Item có phải là cột B trong mảng "A2:B60000"?

Nếu đúng thì việc cần khai báo ParamArray còn có ý nghĩa gì ah?

Rất mong được thày chỉ thêm cho
 
Upvote 0
Phương pháp giải bài toán theo kiểu truyền tham số còn rất mới mẻ với em. Em hiểu:

SubArr có phải là cột A trong mảng "A2:B60000"?
Item có phải là cột B trong mảng "A2:B60000"?

Nếu đúng thì việc cần khai báo ParamArray còn có ý nghĩa gì ah?

Rất mong được thày chỉ thêm cho
Nói ngắn gọn thế này:
- Một hàm thì cần phải có đối số
- Trong trường hợp ta không biết chắc số lượng đối số là bao nhiêu, ta sẽ dùng ParamArray (số lượng đối số tùy ý)
------------
Quay lại hàm UniqueList, nếu bạn chỉ cho có 1 đối số thì đặt trường hợp người ta muốn lấy list duy nhất ở 2 vùng khác nhau và nằm không liền kề nhau (như vùng A1:A10 và E1:E10) thì bạn sẽ làm sao? ----> Nếu đối số thuộc dạng ParamArray thì chuyện này không thành vấn đề
Biến SubArr trong code của tôi có thể xem đó là những đối số nhỏ trong toàn bộ ParamArray ---> Ở bài toán trên, chỉ xài cho 1 vùng A2:B60000 thì xem như ParamArray chỉ có duy nhất 1 đối số nhỏ và đó cũng chính là SubArr ---> Giống như trường hợp For Each Sh in Thisworkbook.Worksheets mà trong Workbook chỉ có 1 sheet duy nhất ấy
 
Upvote 0
Xin thày giúp em chút nữa, em chưa hiểu đoạn này nó có tác dụng gì ah? Tại sao lại cần thêm cả biến Item?
PHP:
For Each Item In tmpArr
          If Item <> "" Then
            If Not .Exists(Item) Then .Add Item, ""
          End If
 
Upvote 0
Xin thày giúp em chút nữa, em chưa hiểu đoạn này nó có tác dụng gì ah? Tại sao lại cần thêm cả biến Item?
PHP:
For Each Item In tmpArr
          If Item <> "" Then
            If Not .Exists(Item) Then .Add Item, ""
          End If

- ParamArray chưa nhiều đối số nhỏ, chính là SubArr
- Trong mỗi SubArr lại chứa nhiều phần tử con (vì SubArr là 1 mảng), các phần tử con chính là biến Item
Mường tượng giống cái này:
Mã:
For Each Sh in Thisworkbook.Worksheets
  For Each Cells in Sh.Range("...Gì gì đó..")
    If Clls <> "" then 
    '....
    '....
  Next
Next
 
Upvote 0
Nói ngắn gọn thế này:
- Một hàm thì cần phải có đối số
- Trong trường hợp ta không biết chắc số lượng đối số là bao nhiêu, ta sẽ dùng ParamArray (số lượng đối số tùy ý)
------------
Quay lại hàm UniqueList, nếu bạn chỉ cho có 1 đối số thì đặt trường hợp người ta muốn lấy list duy nhất ở 2 vùng khác nhau và nằm không liền kề nhau (như vùng A1:A10 và E1:E10) thì bạn sẽ làm sao? ----> Nếu đối số thuộc dạng ParamArray thì chuyện này không thành vấn đề
Biến SubArr trong code của tôi có thể xem đó là những đối số nhỏ trong toàn bộ ParamArray ---> Ở bài toán trên, chỉ xài cho 1 vùng A2:B60000 thì xem như ParamArray chỉ có duy nhất 1 đối số nhỏ và đó cũng chính là SubArr ---> Giống như trường hợp For Each Sh in Thisworkbook.Worksheets mà trong Workbook chỉ có 1 sheet duy nhất ấy
Hình như dùng chỉ ParamArray trường hợp là mãng thôi Sư Phụ à
- ParamArray chưa nhiều đối số nhỏ, chính là SubArr
- Trong mỗi SubArr lại chứa nhiều phần tử con (vì SubArr là 1 mảng), các phần tử con chính là biến Item
Vậy sao em sử dụng Ubound(Cell(N)) trong bài #367 thay
cel(N).Rows.Count
nó báo lỗi ?
 
Lần chỉnh sửa cuối:
Upvote 0
Thưa thày, em sửa thành như thế này:
PHP:
Function UniqueList(ParamArray sArray())
  Dim Item, SubArr
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
        For Each Item In SubArr
          If Item <> "" Then
            If Not .Exists(Item) Then .Add Item, ""
          End If
        Next
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function
PHP:
Sub Loc()
  Dim Arr, SubArr, i As Long
  SubArr = UniqueList(Sheet1.Range("A2:B60000"))
  Sheet2.Range("A:A").ClearContents
  If IsArray(SubArr) Then
    ReDim Arr(1 To UBound(SubArr) + 1, 1 To 1)
    For i = 0 To UBound(SubArr)
      Arr(i + 1, 1) = SubArr(i)
    Next
    Sheet2.Range("A1").Resize(i).Value = Arr
  End If
Chạy ra kết quả nó bị trùng lặp
----------
Trong khi để thế này
PHP:
Function UniqueList(ParamArray sArray())
  Dim Item, tmpArr, SubArr
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
      tmpArr = SubArr
        For Each Item In tmpArr
          If Item <> "" Then
            If Not .Exists(Item) Then .Add Item, ""
          End If
        Next
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function

PHP:
Sub Loc()
  Dim Arr, tmpArr, i As Long
  tmpArr = UniqueList(Sheet1.Range("A2:B60000"))
  Sheet2.Range("A:A").ClearContents
  If IsArray(tmpArr) Then
    ReDim Arr(1 To UBound(tmpArr) + 1, 1 To 1)
    For i = 0 To UBound(tmpArr)
      Arr(i + 1, 1) = tmpArr(i)
    Next
    Sheet2.Range("A1").Resize(i).Value = Arr
  End If
End Sub

Nó lại chạy rất chuẩn ah

Em vẫn còn kém lắm, xin sư phụ đừng la em nhé, rất mong được sư phụ chỉ bảo cho.
 
Upvote 0
Thưa thày, em sửa thành như thế này:
PHP:
Function UniqueList(ParamArray sArray())
  Dim Item, SubArr
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
        For Each Item In SubArr
          If Item <> "" Then
            If Not .Exists(Item) Then .Add Item, ""
          End If
        Next
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function
Chạy ra kết quả nó bị trùng lặp
----------
Trong khi để thế này
PHP:
Function UniqueList(ParamArray sArray())
  Dim Item, tmpArr, SubArr
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
      tmpArr = SubArr
        For Each Item In tmpArr
          If Item <> "" Then
            If Not .Exists(Item) Then .Add Item, ""
          End If
        Next
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function


Nó lại chạy rất chuẩn ah

Em vẫn còn kém lắm, xin sư phụ đừng la em nhé, rất mong được sư phụ chỉ bảo cho.
Bới vậy mới thấy đâu phải vô lý mà người ta gán tmpArr = SubArr mặc dù nhìn có vẽ như 2 thằng là 1
Hãy xem câu đố vui về VBA tại đây:
http://www.giaiphapexcel.com/forum/showthread.php?7146-Đố-vui-về-VBA!/page24
Xem từ bài 238 đến bài 242... có đề cập vấn đề này đấy
-----------------
Hình như dùng chỉ ParamArray trường hợp là mãng thôi Sư Phụ à

Vậy sao em sử dụng Ubound(Cell(N)) trong bài #367 thay
cel(N).Rows.Count
nó báo lỗi ?
ParamArray đương nhiên là biến mảng, còn các đối số con trong nó thì là cái gì cũng được (không nhất thiết phải là mảng đâu)
Vậy bạn xem lại Cell(N) là biến gì? Nếu nó là Range, trước tiên bạn phải chuyển nó thành Array (bằng cách gán tmpArr = Cell(N) giống như cách tôi làm với hàm UniqueList chẳng hạn)... Tiếp theo, muốn dùng UBound thì phải xem nó là mảng 2 chiều (Ubound(... , 1) hoặc UBound(... , 2) mới xong)
 
Lần chỉnh sửa cuối:
Upvote 0
Trong Code này của sư phụ

PHP:
Function UniqueList(ParamArray sArray())
  Dim Item, tmpArr, SubArr
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
      tmpArr = SubArr
      If TypeName(tmpArr) <> "Variant()" Then
        If tmpArr <> "" Then .Add tmpArr, ""
      Else
        For Each Item In tmpArr
          If Item <> "" Then
            If Not .Exists(Item) Then .Add Item, ""
          End If
        Next
      End If
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function


Sư phụ có thể minh họa dùm em trong trường hợp cụ thể mà nếu không có dòng
PHP:
If TypeName(tmpArr) <> "Variant()" Then
        If tmpArr <> "" Then .Add tmpArr, ""
      Else
thì bài toán "đi teo", tức là ra kết quả sai
 
Upvote 0
Trong Code này của sư phụ
Sư phụ có thể minh họa dùm em trong trường hợp cụ thể mà nếu không có dòng
PHP:
If TypeName(tmpArr) <> "Variant()" Then
        If tmpArr <> "" Then .Add tmpArr, ""
      Else
thì bài toán "đi teo", tức là ra kết quả sai
Câu lệnh If TypeName(tmpArr) <> "Variant()" Then là để phòng trường hợp tmpArr được gán từ SubArr màSubArr lại chỉ là 1 cell duy nhất ---> Dẫn đến tmpArr không thể trở thành Array
Ví dụ bạn cần lọc duy nhất từ 3 vùng
- Vùng 1 = Range("A1:C10")
- Vùng 2 = Range("D2")
- Vùng 3 = Range("F20:H30")

Bạn thấy ngay nếu biến tmpArr được gán từ Vùng 2 thì tmpArr không thể trở thành Array (do Vùng 2 chỉ là 1 cell duy nhất)
Vậy toàn bộ đoạn code:
PHP:
tmpArr = SubArr
If TypeName(tmpArr) <> "Variant()" Then
  If tmpArr <> "" Then .Add tmpArr, ""
Else
  For Each Item In tmpArr
    If Item <> "" Then
      If Not .Exists(Item) Then .Add Item, ""
    End If
   Next
End If
Có nghĩa là:
- Nếu tmpArr không phải là mảng thi nạp nó trực tiếp vào Dictionary (nếu như nó khác rổng)
- Ngược lại, tmpArr là mảng thì dùng vòng lập duyệt qua các phần tử của tmpArr, xét các phần tử này, nếu khác rổng thì nạp vào Dictionary
----------------
Câu lệnh dưới If tmpArr <> "" Then .Add tmpArr, "" ---> Mình chỉ lấy phần tử nào có dữ liệu thôi, rổng ta không lấy
 
Lần chỉnh sửa cuối:
Upvote 0
Câu lệnh If TypeName(tmpArr) <> "Variant()" Then là để phòng trường hợp tmpArr được gán từ SubArr màSubArr lại chỉ là 1 cell duy nhất ---> Dẫn đến tmpArr không thể trở thành Array

Em vẫn còn kém lắm chưa phân biệt rõ ràng được sự giống và khác nhau giữa Range và Variant, bởi em tưởng đơn giản trường hợp SubArr lại chỉ là 1 cell duy nhất thì giá trị của Cell đó vẫn có thể là Variant chứ ah?
 
Upvote 0
Em vẫn còn kém lắm chưa phân biệt rõ ràng được sự giống và khác nhau giữa Range và Variant, bởi em tưởng đơn giản trường hợp SubArr lại chỉ là 1 cell duy nhất thì giá trị của Cell đó vẫn có thể là Variant chứ ah?

Hiểu đơn giản thì Variant là mảng đi, còn Range thì là... range thôi (là 1 vùng nào đó)
Một cell đơn sao có thể là Variant được chứ, nó chỉ có thể là dạng chuổi, số gì gì đó thôi, đúng không?
Làm 1 cuộc thí nghiệm nhỏ thế này:
PHP:
Sub Test()
  Dim Arr
  Arr = Range("A1:C10").Value
  MsgBox UBound(Arr, 1)
  MsgBox UBound(Arr, 2)
End Sub
Vùng dữ liệu A1:C10 được chuyển vào Arr nên Arr sẽ là 1 mảng
Nhưng thay A1:C10 thành A1 (tức chỉ còn lại là 1 cell đơn).. rồi chạy code sẽ bị lỗi ngay... Lý do cell đơn chuyển vào Arr thì Arr không thể là mảng ---> dẫn đến việc không tồn tại mấy cái UBound(...)
 
Lần chỉnh sửa cuối:
Upvote 0
Nghĩa là mảng phải có ít nhất từ 2 phần tử trở lên hả thày?
 
Upvote 0
Nghĩa là mảng phải có ít nhất từ 2 phần tử trở lên hả thày?
Không phải vậy!
Mảng có 1 phần tử cũng không ai cấm... Vấn đề là nếu mảng ấy được tạo thành từ range thì range ấy phải có từ 2 cell trở lên
(Còn mảng do ta tự tạo ra, muốn mấy phần tử mà chẳng được)
 
Upvote 0
Code của thày Ndu, em cho thêm thành phần MsgBox LBound(tmpArr, 1), cụ thể :

PHP:
Function UniqueList(ParamArray sArray())
    Dim Item, tmpArr, SubArr
    On Error Resume Next
    With CreateObject("Scripting.Dictionary")
        For Each SubArr In sArray
            tmpArr = SubArr
            If TypeName(tmpArr) <> "Variant()" Then
                If tmpArr <> "" Then .Add tmpArr, ""
            Else
                For Each Item In tmpArr
                    If Item <> "" Then
                        If Not .Exists(Item) Then .Add Item, ""
                    End If
                Next
            End If
        Next
        MsgBox LBound(tmpArr, 1)
        If .Count Then UniqueList = .Keys
    End With
End Function

PHP:
Sub Loc()
    Dim Arr, tmpArr, i As Long
    tmpArr = UniqueList(Sheet1.Range("A2:B60000"))
    Sheet2.Range("A:A").ClearContents
    If IsArray(tmpArr) Then
        ReDim Arr(1 To UBound(tmpArr) + 1, 1 To 1)
        For i = 0 To UBound(tmpArr)
            Arr(i + 1, 1) = tmpArr(i)
        Next
        Sheet2.Range("A1").Resize(i).Value = Arr
    End If
End Sub

Em thắc mắc là kiểm tra Msgbox LBound(TmpArr,1) = 1 trong khi tại sao i lại chạy từ 0 trong Code:
PHP:
For i = 0 To UBound(tmpArr)

---------------
Do em chưa hiểu về bản chất của ParamArray, em xin hỏi xuất phát từ

PHP:
tmpArr = UniqueList(Sheet1.Range("A2:B60000"))

có nghĩa là tmpArr=sArray chứ thay vì bằng SubArr như Code trên.
 
Upvote 0
=

Em thắc mắc là kiểm tra Msgbox LBound(TmpArr,1) = 1 trong khi tại sao i lại chạy từ 0 trong Code:
PHP:
For i = 0 To UBound(tmpArr)

---------------
Do em chưa hiểu về bản chất của ParamArray, em xin hỏi xuất phát từ

PHP:
tmpArr = UniqueList(Sheet1.Range("A2:B60000"))

có nghĩa là tmpArr=sArray chứ thay vì bằng SubArr như Code trên.
2 cái tmpArr khác nhau mà bạn!
- Một cái tmpArr trong Function UniqueList được gán từ SubArr... Mà SubArr là 1 đối số con của ParamArray và đối số này được truyền từ Range("A2:B60000") ---> Cuối cùng, kết luận trong trường hợp này thì tmpArr chính là mảng được gán từ Range, đúng không? ===> LBound(tmpArr,1) luôn = 1 (mảng 2 chiều Base 1)
- Một cái tmpArr trong Sub Loc, kết quả của nó được lấy từ tmpArr = UniqueList(Sheet1.Range("A2:B60000"))... UniqueList lại được lấy từ Keys của Dictionary (UniqueList = .Keys) mà như tôi đã nói thì Keys của Dictionary luôn là mảng 1 chiều Base 0 nên phải For i = 0 là đúng rồi
----------------
Tóm lại:
- Đừng để ý tên biến, chúng có tên giống nhau nhưng nằm ở 2 code khác nhau thì đương nhiên chúng có tính chất khác nhau
- Muốn biết tính chất của 1 mảng, phải xem chúng được tạo từ đâu rồi truy ra cho đến nguồn gốc
 
Upvote 0
Thế mà em cứ tưởng 2 thằng giống nhau, cảm ơn thày rất nhiều, giá như Sub thày viết thành:

PHP:
Sub Loc()
    Dim Arr, tmpArr1, i As Long
    tmpArr1 = UniqueList(Sheet1.Range("A2:B60000"))
    Sheet2.Range("A:A").ClearContents
    If IsArray(tmpArr1) Then
        ReDim Arr(1 To UBound(tmpArr1) + 1, 1 To 1)
        For i = 0 To UBound(tmpArr1)
            Arr(i + 1, 1) = tmpArr1(i)
        Next
        Sheet2.Range("A1").Resize(i).Value = Arr
    End If
End Sub

thì em đỡ ngộ nhận là 2 tên là 1.

Từ hôm qua nhờ có thày giúp em cảm thấy tiếp thu được rất nhiều kiến thức thiết thực nhất từ khi bắt đầu đọc VBA (trước kia đọc lý thuyết xong để đấy, không có kỹ năng thực hành + nhận thức nhiều cái sai)---> khi bài toán đơn giản cũng thấy lúng túng, được như vậy là nhờ công lao rất lớn của thày, bản thân em cũng thấy rất vui, tự tin hơn rất nhiều khi làm bài.
------------
Em xin hỏi chút nữa là trong trường hợp này tmpArr = UniqueList(Sheet1.Range("A2:B60000")) ----> sArray = SubArray đúng không ah?

Thế còn trong trường hợp này
PHP:
 tmpArr = UniqueList(.[A2:A60000], .[E2:E60000], .[H2:H60000])
---> SubArr = [A2:A60000] hoặc SubArr = [E2:E60000] hoặc SubArr = [H2:H60000]
còn sArray là tập hợp cả 3 thằng trên tức sArray =.[A2:A60000], .[E2:E60000], .[H2:H60000]

Kính chúc thày luôn mạnh khỏe, hạnh phúc.
 
Lần chỉnh sửa cuối:
Upvote 0
Theo ý em hiểu thì SArray là đối tượng Range, nhưng sao khi khai báo lại có (), cụ thể
PHP:
Function UniqueList(ParamArray sArray())

Em xin hỏi thêm 1 chút là cách viết
PHP:
If TypeName(tmpArr) = "Variant()" Then
và cách viết
PHP:
If IsArray(tmpArr) Then

Có tương đương không ah?
 
Upvote 0
Chào bạn Dauthivan
Xem câu hỏi trên cũng thấy rằng bạn đã tiến bộ
Thiết nghĩ rằng tôi cũng không cần phải trả lời bạn nữa... Những thứ mà bạn cảm giác thế này, cảm giác thế nọ... vân vân... cứ hãy đợi thời gian trả lời ---> Tức làm nhiều, tự nhiên sẽ hiểu càng nhiều
Nói chung, tôi cảm thấy gần như bạn đã đi đúng hướng rồi đấy ---> Cứ thế mà cố gắng nhé
Ẹc.. Ẹc...
 
Upvote 0
anh ndu cho em hỏi tí, em có đọc code này của anh thấy áp dụng rất tốt, nhưng mà bây giờ em muốn chổ màu đỏ nó hiện trên 1 dòng, em không muốn hiện trên 1 cột thì phải sửa như thế nào? xin cảm ơn anh
dòng màu đỏ đó là đưa dữ liệu lên sheet2 thành 1 cột nhưng bây giờ em muốn hiện lên 1 dòng thì cần thay Resize(i) như thế nào?


Function UniqueList(ParamArray sArray())
Dim Item, tmpArr, SubArr
On Error Resume Next
With CreateObject("Scripting.Dictionary")
For Each SubArr In sArray
tmpArr = SubArr
If TypeName(tmpArr) <> "Variant()" Then
If tmpArr <> "" Then .Add tmpArr, ""
Else
For Each Item In tmpArr
If Item <> "" Then
If Not .Exists(Item) Then .Add Item, ""
End If
Next
End If
Next
If .Count Then UniqueList = .Keys
End With
End Function


Sub Loc()
Dim Arr, tmpArr, i As Long
tmpArr = UniqueList(Sheet1.Range("A2:B60000"))
Sheet2.Range("A:A").ClearContents
If IsArray(tmpArr) Then
ReDim Arr(1 To UBound(tmpArr) + 1, 1 To 1)
For i = 0 To UBound(tmpArr)
Arr(i + 1, 1) = tmpArr(i)
Next
Sheet2.Range("A1").Resize(i).Value = Arr
End If
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
anh ndu cho em hỏi tí, em có đọc code này của anh thấy áp dụng rất tốt, nhưng mà bây giờ em muốn chổ màu đỏ nó không hiện 1 dòng, mà em cần nó muốn hẹn 1 cột thì phải sửa như thế nào? xin cảm ơn anh
dòng màu đỏ đó là đưa dữ liệu lên sheet2 thành 1 cột nhưng bây giờ em muốn hiện lên 1 dòng thì cần thay Resize(i) như thế nào?


Function UniqueList(ParamArray sArray())
Dim Item, tmpArr, SubArr
On Error Resume Next
With CreateObject("Scripting.Dictionary")
For Each SubArr In sArray
tmpArr = SubArr
If TypeName(tmpArr) <> "Variant()" Then
If tmpArr <> "" Then .Add tmpArr, ""
Else
For Each Item In tmpArr
If Item <> "" Then
If Not .Exists(Item) Then .Add Item, ""
End If
Next
End If
Next
If .Count Then UniqueList = .Keys
End With
End Function


Sub Loc()
Dim Arr, tmpArr, i As Long
tmpArr = UniqueList(Sheet1.Range("A2:B60000"))
Sheet2.Range("A:A").ClearContents
If IsArray(tmpArr) Then
ReDim Arr(1 To UBound(tmpArr) + 1, 1 To 1)
For i = 0 To UBound(tmpArr)
Arr(i + 1, 1) = tmpArr(i)
Next
Sheet2.Range("A1").Resize(i).Value = Arr
End If
End Sub

Vì hàm UniqueList trả về kết quả là mảng 1 chiều nên sẽ càng dễ hơn nếu bạn muốn đặt kết quả trên 1 dòng. Khi ấy không cần phải vòng lập nữa mà cứ việc gán trực tiếp kết quả xuống sheet là được
Cụ thể Sub Loc như sau:
Mã:
Sub Loc()
  Dim Arr
  Arr = UniqueList(Sheet1.Range("A2:B60000"))
  Sheet2.Range("1:1").ClearContents
  If IsArray(Arr) Then
    Sheet2.Range("A1").Resize(, UBound(Arr) + 1).Value = Arr
  End If
End Sub
Riêng hàm UniqueList cũng nên sửa lại 1 chút:
Mã:
Function UniqueList(ParamArray sArray())
  Dim Item, tmpArr, SubArr, tmp
  On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
      tmpArr = SubArr
      If Not IsArray(tmpArr) Then tmpArr = Array(tmpArr)
      For Each Item In tmpArr
        tmp = CStr(Item)
        If Len(tmp) Then
          If Not .Exists(tmp) Then .Add tmp, ""
        End If
      Next
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function
 
Lần chỉnh sửa cuối:
Upvote 0
Từ hôm qua nhờ có thày giúp em cảm thấy tiếp thu được rất nhiều kiến thức thiết thực nhất từ khi bắt đầu đọc VBA (trước kia đọc lý thuyết xong để đấy, không có kỹ năng thực hành + nhận thức nhiều cái sai)---> khi bài toán đơn giản cũng thấy lúng túng, được như vậy là nhờ công lao rất lớn của thày, bản thân em cũng thấy rất vui, tự tin hơn rất nhiều khi làm bài..
Tôi thấy bạn chả có gì mà phải lúng túng cả. cớ hiểu thế nào thì mần như thế đó. bí hỏi các cao thủ GPE chỉ . trên đời chả ai giỏi hơn ai. mình yếu cái này nhưng mạnh cái kia. mà có khi cái mạnh của mình mà mình không biết.
 
Upvote 0

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

Back
Top Bottom