Hỏi về Listbox trong excel

minhxaydungvinh đã viết:

Mọi người cho mình hỏi giả sử mình có 1 danh sách công việc từ b2 đến b100 được link công thức từ sheet khác. Trong danh sách công việc này sẽ có những ô rỗng (rỗng chứ không phải là trống vì nó có link công thức). Làm thế nào để tạo ra 1 listbox mà chỉ có những ô không rỗng. Mong mọi người giúp

Nhấp chuột vào đây để mở rộng...

ndu96081631 đã viết:

Viết code VBA duyệt qua mảng dữ liệu, cái nào rổng ta bỏ qua, cái nào không rổng ta cho vào listbox. Vậy thôi!
Ngoài ra, nếu có nhu cầu lọc không trùng ta dùng thêm Dictionary

Nhấp chuột vào đây để mở rộng...

minhxaydungvinh đã viết:

Cảm ơn thầy. Có cách nào không dùng VBA không ạ. Nếu dùng VBA thầy có thể cho e 1 ví dụ được không ạ. Tại e đang dùng đt nên không post file lên đây được

Nhấp chuột vào đây để mở rộng...

Function UniqueRange(ByVal SourceRange As Range)
  Dim aSrc, item, vTmp, i As Long
  Dim dic As Object
  aSrc = SourceRange.Value
  Set dic = CreateObject("Scripting.Dictionary")
  For Each item In aSrc
    If TypeName(item) <> "Error" Then
      If Len(item) Then
        If Not dic.Exists(item) Then dic.Add item, Nothing
      End If
    End If
  Next
  If dic.Count Then UniqueRange = dic.Keys
End Function

Sub AddList()
  Dim arr
  arr = UniqueRange(Range("B2:B10"))
  If IsArray(arr) Then Sheet1.ListBox1.List() = arr
End Sub

ndu96081631 đã viết:

Nếu không dùng VBA thì bạn dùng công thức trích lọc sang 1 cột phụ, xong mới gán cọt phụ này vào listbox. Liên quan đến lọc theo điều kiện đã có đầy trên GPE này rồi
Còn VBA cũng khá đa dạng, viết từ đơn giản đến phức tạp (tùy theo nhu cầu)
Ví dụ đơn giản thế này:
1> Tạo 1 hàm lọc duy nhất nằm trong 1 module

Mã:Sao chép.

Function UniqueRange(ByVal SourceRange As Range)
  Dim aSrc, item, vTmp, i As Long
  Dim dic As Object
  aSrc = SourceRange.Value
  Set dic = CreateObject("Scripting.Dictionary")
  For Each item In aSrc
    If TypeName(item) <> "Error" Then
      If Len(item) Then
        If Not dic.Exists(item) Then dic.Add item, Nothing
      End If
    End If
  Next
  If dic.Count Then UniqueRange = dic.Keys
End Function

2> Áp dụng nạp list cho ListBox1

Mã:Sao chép.

Sub AddList()
  Dim arr
  arr = UniqueRange(Range("B2:B10"))
  If IsArray(arr) Then Sheet1.ListBox1.List() = arr
End Sub

Nhấp chuột vào đây để mở rộng...

ndu96081631 đã viết:

Nếu không dùng VBA thì bạn dùng công thức trích lọc sang 1 cột phụ, xong mới gán cọt phụ này vào listbox. Liên quan đến lọc theo điều kiện đã có đầy trên GPE này rồi
Còn VBA cũng khá đa dạng, viết từ đơn giản đến phức tạp (tùy theo nhu cầu)
Ví dụ đơn giản thế này:
1> Tạo 1 hàm lọc duy nhất nằm trong 1 module

Mã:Sao chép.

Function UniqueRange(ByVal SourceRange As Range)
  Dim aSrc, item, vTmp, i As Long
  Dim dic As Object
  aSrc = SourceRange.Value
  Set dic = CreateObject("Scripting.Dictionary")
  For Each item In aSrc
    If TypeName(item) <> "Error" Then
      If Len(item) Then
        If Not dic.Exists(item) Then dic.Add item, Nothing
      End If
    End If
  Next
  If dic.Count Then UniqueRange = dic.Keys
End Function

2> Áp dụng nạp list cho ListBox1

Mã:Sao chép.

Sub AddList()
  Dim arr
  arr = UniqueRange(Range("B2:B10"))
  If IsArray(arr) Then Sheet1.ListBox1.List() = arr
End Sub

Nhấp chuột vào đây để mở rộng...

hic1802 đã viết:

Thầy ơi, nếu mình sử dụng hàm UniqueRange vào 1 ô excel bất kỳ thì nó chỉ ra 1 giá trị B2, muốn nó hiển thị cả chuỗi các giá trị khác thì hàm UniqueRange phải xây dựng ntn?

Nhấp chuột vào đây để mở rộng...

ndu96081631 đã viết:

Hiển thị cả chuỗi là hiển thị sao?

Nhấp chuột vào đây để mở rộng...

hic1802 đã viết:

Dạng như hình vẽ thầy @ndu96081631
View attachment 181978

Nhấp chuột vào đây để mở rộng...

=INDEX(UniqueRange($A$1:$A$30),ROWS($1:1))

=IFERROR(INDEX(UniqueRange($A$1:$A$30),ROWS($1:1)),"")

Sub Main()
  Dim arr
  arr = UniqueRange(Range("A1:A30"))
  If IsArray(arr) Then Range("C1").Resize(UBound(arr) + 1).Value = Application.Transpose(arr)
End Sub

ndu96081631 đã viết:

Hàm trên trả về 1 mảng. Vậy muốn lấy ra từng cell ta có 2 cách:
1> Cách 1: Dùng INDEX để trích ra từng phần tử, ví dụ:

Mã:Sao chép.

=INDEX(UniqueRange($A$1:$A$30),ROWS($1:1))

Kéo fill công thức đến khi nào gặp lỗi thì ngưng
Hoặc có thể lồng thêm hàm bẫy lỗi vào:

Mã:Sao chép.

=IFERROR(INDEX(UniqueRange($A$1:$A$30),ROWS($1:1)),"")

2> Cách 2: Viết thêm 1 sub để gán dữ liệu xuống sheet

Mã:Sao chép.

Sub Main()
  Dim arr
  arr = UniqueRange(Range("A1:A30"))
  If IsArray(arr) Then Range("C1").Resize(UBound(arr) + 1).Value = Application.Transpose(arr)
End Sub

Nhấp chuột vào đây để mở rộng...