Sửa lại code lọc mảng (2 người xem)

[baucua]

Cái này E sưu tầm trên GPE
Các bác sửa giúp E lại cái code lọc mảng,
phần kết quả có hàng rỗng thành danh sách duy nhất ko có hàng rỗng nhé.
Các bác xem file đính kèm

 

[khoavu87]

Cái này E sưu tầm trên GPE
Các bác sửa giúp E lại cái code lọc mảng,
phần kết quả có hàng rỗng thành danh sách duy nhất ko có hàng rỗng nhé.
Các bác xem file đính kèm

-bạn tham khảo code này của ndu xem sao/

 

[sealand]

Mình thấy code hơi rối, nên tham gia code khác. Code của mình vừa lọc vừa sắp xếp

Function Dsach(ByVal Rg As Range, id As Integer)
Dim cl As Range, mg(), i, j, tam
Dim DS As New Collection
Application.Volatile
On Error Resume Next
For Each cl In Rg.Cells
If Trim(cl) <> "" Then DS.Add cl.Value, CStr(cl.Value)
Next
ReDim mg(DS.Count)
For i = 1 To DS.Count: mg(i - 1) = DS(i): Next
For i = 0 To UBound(mg)
For j = i + 1 To DS.Count - 1
If mg(i) > mg(j) Then
tam = mg(i): mg(i) = mg(j): mg(j) = tam
End If: Next: Next
If id > UBound(mg) Then
Dsach = ""
Else
Dsach = mg(id - 1)
End If
End Function

 

[sealand]

Mình hiệu chính Code 1 chút:

Function Dsach(ByVal Rg As Range, id As Integer)
   Dim cl As Range, mg(), i, j, tam
     Dim DS As New Collection
      On Error Resume Next
         For Each cl In Rg.Cells
          If Trim(cl) <> "" Then DS.Add cl.Value, CStr(cl.Value)
         Next
ReDim mg(DS.Count)
  For i = 1 To DS.Count: mg(i - 1) = DS(i): Next
For i = 0 To UBound(mg) - 1
 For j = i + 1 To DS.Count - 1
  If mg(i) > mg(j) Then
    tam = mg(i): mg(i) = mg(j): mg(j) = tam
   End If: Next: Next
If id > UBound(mg) Then
Dsach = ""
Else
Dsach = mg(id - 1)
End If
End Function

Cú pháp : = DSach( Rg , id )
​

Trong đó:

Rg: Vùng nguồn tạo danh sách.
Id: Số phần tử của Danh sách
​

 

[ndu96081631]

Mình thấy code hơi rối, nên tham gia code khác. Code của mình vừa lọc vừa sắp xếp

Cái code "hơi rối" ấy có thể lọc được vùng dữ liệu không liên tục luôn đấy anh Sealand à ---> Ngoài ra nó cũng có thể biến kết quả thành dòng hay cột tùy thích nữa đấy
Anh xem ở đây:
http://www.giaiphapexcel.com/forum/...y-dữ-liệu-từ-nhiều-hàng-thành-1-hàng-và-1-cột

 

[sealand]

Đúng là mình chưa Test nhưng đã UDF rồi mà lại tiếp tục dùng bằng công thức mảng nữa nên ngại. Hơn nữa, code đó mới chuyển vùng thành cột hay hàng chứ chưa làm việc lọc DS duy nhất

 

[ndu96081631]

Đúng là mình chưa Test nhưng đã UDF rồi mà lại tiếp tục dùng bằng công thức mảng nữa nên ngại. Hơn nữa, code đó mới chuyển vùng thành cột hay hàng chứ chưa làm việc lọc DS duy nhất

Nếu dùng UDF thì cũng đâu cần nhiều vòng lập thế anh ơi!
Em dùng 1 vòng lập đây:

Function Dsach(ByVal SrcRng As Range, id As Long)
  Dim TmpArr, Item
  TmpArr = SrcRng
  For Each Item In TmpArr
    If Trim(Item) <> "" Then
      id = id - 1
      If id = 0 Then
        Dsach = Item
        Exit Function
      End If
    End If
  Next
End Function

Cú pháp hàm cũng giống như anh đã trình bày (=DSach( SrcRng , id ))

 

[baucua]

Các bác giúp E sửa cái CT mà E sưu tầm được không ?
E muốn CT đó lọc mảng nhưng theo các cột dữ liệu ko liền nhau :

{= OB(mảng_cột_1,mảng cột 2,..,mảng_cột_n)}

Ví dụ mảng cột ko liền nhau: A5:A11: 1 3 4 1 2 3 C7:C11 : 90 4 5 6 7 E9:E11 : df r r

 

[ndu96081631]

Các bác giúp E sửa cái CT mà E sưu tầm được không ?
E muốn CT đó lọc mảng nhưng theo các cột dữ liệu ko liền nhau :

{= OB(mảng_cột_1,mảng cột 2,..,mảng_cột_n)}

CT gì gì nó là cái gì? File đâu?
Và 1 câu hỏi nhỏ: Bạn muốn code là 1 Sub hay 1 Function?

 

[baucua]

File đó đây ạ, bác sửa giùm cái code đó loại hàng trống nhé: Sao hôm nay E vào GPE chậm rì rì vậy

 

[ndu96081631]

File đó đây ạ, bác sửa giùm cái code đó loại hàng trống nhé: Sao hôm nay E vào GPE chậm rì rì vậy

Code của bạn tôi sửa thành vầy:

Function OB(ParamArray SrcArr())
  Dim TmpArr, Item, i As Long, j As Long, Arr(1 To 10000, 1 To 1)
  For i = LBound(SrcArr) To UBound(SrcArr)
    TmpArr = SrcArr(i)
    For Each Item In TmpArr
      If Trim(Item) <> "" And Item <> 0 Then
        j = j + 1
        Arr(j, 1) = Item
      End If
    Next
  Next
  OB = Arr
End Function

Sử dụng:
- Quét chọn 1 vùng tùy ý (1 cột nhiều dòng)
- Gõ vào thanh Formula công thức =OB(Vùng 1, Vùng 2, Vùng 3,....., Vùng n)
- Ví dụ: =OB(A5:A11,C7:C11,E9:E11)
------------------------
Mạng GPE từ sáng đến giờ đúng là chậm quá trời đi thôi

 

[sealand]

Nếu dùng UDF thì cũng đâu cần nhiều vòng lập thế anh ơi!
.....................
Cú pháp hàm cũng giống như anh đã trình bày (=DSach( SrcRng , id ))

Đúng là Ndu luôn tìm cách tối ưu code.
Nhưng đoạn Code của Ndu còn thiếu 2 phần:

-Lọc Danh sách duy nhất.
-Sắp xếp lại.
​

Chính vì vậy, nó cũng bớt đi khá số lượng vòng lặp.

 

[ndu96081631]

Đúng là Ndu luôn tìm cách tối ưu code.
Nhưng đoạn Code của Ndu còn thiếu 2 phần:

-Lọc Danh sách duy nhất.
-Sắp xếp lại.
​

Chính vì vậy, nó cũng bớt đi khá số lượng vòng lặp.

Vâng! Nhưng em đâu nghe tác giả đề cập đến vụ LỌC DUY NHẤT... chính thể mà em không dùng Collection hay Dictionary
Mà cho dù có lọc duy nhất thì em cũng dùng 1 vòng lập thôi anh à!
Ví dụ thế này

Function Dsach(ByVal SrcRng As Range, id As Long)
  Dim TmpArr, Item
  TmpArr = SrcRng
  With CreateObject("Scripting.Dictionary")
    For Each Item In TmpArr
      If Trim(Item) <> "" And Not .Exists(Item) Then
        id = id - 1
        .Add Item, ""
        If id = 0 Then
          Dsach = Item
          Exit Function
        End If
      End If
    Next
  End With
End Function

Và nếu có thêm vụ SORT thì em sẽ dùng cái này:
http://www.giaiphapexcel.com/forum/showthread.php?38005-Sắp-xếp-mảng-dữ-liệu-không-sử-dụng-vòng-lặp
Cũng không vòng lập luôn!
Anh kiểm tra lại xem có gì không ổn không?

 

[sealand]

Ôi cái vụ Sort này hay quá đi mất. Mình không phát hiện ra nó có trên GPE.
À, yêu cầu duy nhất là từ bài 1 cơ.

 

[ndu96081631]

Ôi cái vụ Sort này hay quá đi mất. Mình không phát hiện ra nó có trên GPE.
À, yêu cầu duy nhất là từ bài 1 cơ.

Oh... em không đọc kỹ yêu cầu rồi...
Vậy em sửa lại code trên nhé:

Function OB(ParamArray SrcArr())
  Dim TmpArr, Item, i As Long, j As Long, Arr(1 To 10000, 1 To 1)
  With CreateObject("Scripting.Dictionary")
    For i = LBound(SrcArr) To UBound(SrcArr)
      TmpArr = SrcArr(i)
      For Each Item In TmpArr
        If Trim(Item) <> "" And Item <> 0 Then
          If Not .Exists(Item) Then
            j = j + 1
            .Add Item, j
            Arr(j, 1) = Item
          End If
        End If
      Next
    Next
    OB = Arr
  End With
End Function

Code này vẫn chưa sorf ---> Muốn sort, hãy dùng hàm của rollover79 lồng vào

 

[Ếch Xanh]

Xin lỗi post sai chỗ! Xin Xóa dùm bài này!

 

[ndu96081631]

Xin lỗi post sai chỗ! Xin Xóa dùm bài này!

Hi... hi... bạn làm tôi cũng... sai theo rồi nhé

 

[sealand]

Code này vẫn chưa sorf ---> Muốn sort, hãy dùng hàm của rollover79 lồng vào

Tai sao mình lồng vào toàn báo lỗi nhỉ?

 

[baucua]

Thật tuyệt, code bác ndu96081631 đã đáp ứng đúng yêu cầu E rùi :

 Function OB(ParamArray SrcArr())
  Dim TmpArr, Item, i As Long, j As Long, Arr(1 To 10000, 1 To 1)
  With CreateObject("Scripting.Dictionary")
    For i = LBound(SrcArr) To UBound(SrcArr)
      TmpArr = SrcArr(i)
      For Each Item In TmpArr
        If Trim(Item) <> "" And Item <> 0 Then
          If Not .Exists(Item) Then
            j = j + 1
            .Add Item, j
            Arr(j, 1) = Item
          End If
        End If
      Next
    Next
    OB = Arr
  End With
End Function

Nhân tiện bác có thể chú thích thuật toán này ko?, vì E thấy ứng dụng này rất hay dùng trong thực tế.
Thank so much!!!

 

[ThuNghi]

Tai sao mình lồng vào toàn báo lỗi nhỉ?

Em cũng đọc thấy code về Java của Rollover và vận dụng của NDU mà cũng hú thật là chưa biết cách truyền tham số (lồng) code trên vào để sort.
Mong NDU và Rollover cụ thể giúp.
Cám ơn.