(آموزشی) نمایش فقط مقادیر فیلتر شده در لیست باکس ها

[ali.b]

سلام
با کدهای زیر می توانید بعد از اجرای کد های مختص فیلتر کردن رنج ها، لیست باکس ها هم نتایج فیلتر رو هم نشون بدن و فقط مقادیری که نمایش داده میشوند را بارگزاری نمایند
بر اساس نوع کار چندین کد قرار می دم ممکنه برحسب نوع کد نویسی شما ممکنه نیاز به حالت های متفاوت باشین

Sub list()
ListBox1.Clear
Dim Rng As Range
    Dim rw As Range
    Dim i As Long, j As Long
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    Set Rng = Range("A1:A" & lastrow).SpecialCells(xlCellTypeVisible)
    Sheet3.Activate
    For Each rw In Rng
        ListBox1.AddItem
        For i = 1 To 6
            ListBox1.list(ListBox1.ListCount - 1, i - 1) = rw.Cells(1, i).Value
        Next i
    Next rw
End Sub

ListBox1.ClearWith ThisWorkbook.Sheets("fdb")
Set Rng = .Range("A1", .Range("A1").End(xlDown)).SpecialCells(xlCellTypeVisible)
End With
For Each cell In Rng.Cells
If Range("a2").Value = "" Then
Exit Sub
End
ElseIf Range("a2").Value <> "" Then
With Me.ListBox1
.AddItem cell.Value
.list(.ListCount - 1, 1) = cell.Offset(0, 1).Value
.list(.ListCount - 1, 2) = cell.Offset(0, 3).Value
.list(.ListCount - 1, 3) = cell.Offset(0, 5).Value
.list(.ListCount - 1, 4) = cell.Offset(0, 6).Value
.list(.ListCount - 1, 5) = cell.Offset(0, 7).Value
.list(.ListCount - 1, 6) = cell.Offset(0, 10).Value
End With
End If
Next cell

Dim c As Range
LR = Sheets("fdb").Range("A" & Rows.Count).End(xlUp).Row
With ListBox1
    .ColumnCount = 7
    For Each oneCell In Sheets("fdb").Range("A1:A" & LR).SpecialCells(xlCellTypeVisible)
        .AddItem CStr(oneCell.Value)
        .list(.ListCount - 1, 1) = oneCell.Offset(0, 1).Value
        .list(.ListCount - 1, 2) = oneCell.Offset(0, 2).Value
        '...
        .list(.ListCount - 1, 7) = oneCell.Offset(0, 7).Value
    Next oneCell
End With

پیشنهادی

Dim rngCell As Range 
  Dim n As Long
   Dim lngColumns As Long
   ListBox1.Clear
   With Sheet7.Cells(1).CurrentRegion
      lngColumns = .Columns.Count
      For Each rngCell In .Columns(1).SpecialCells(xlCellTypeVisible)
         With ListBox1
            .AddItem rngCell.Value
            For n = 1 To lngColumns - 1
               .list(.ListCount - 1, n) = rngCell.Offset(, n).Value
            Next n
         End With
      Next rngCell
   End With

ListBox1.Clear

ListBox1.list = Sheet10.Cells(1).CurrentRegion.Value
    For J = UBound(ListBox1.list) To 1 Step -1
        If Intersect(Cells(J + 1, 1), Sheet10.UsedRange.Columns(1).SpecialCells(xlCellTypeVisible)) _
        Is Nothing Then ListBox1.RemoveItem J
    Next

اخطار: این یک موضوع قدیمی است به دلیل قدیمی بودن موضوع، ممکن است برخی فایل های ضمیمه به درستی کار نکنند. لطفا در صورت عدم ضرورت، از بالا آوردن موضوعات قدیمی خودداری نمایید.