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

Collapse
X
 
  • زمان
  • نمایش
حذف همه
new posts
  • ali.b

    • 2014/01/12
    • 798

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

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


    کد:
    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
    [CENTER]
    [/CENTER]
چند لحظه..