Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Сортировка ListBox. VBA
 
Здравствуйте, каким образом можно отсортировать значения в ListBox от А до Я?

Код
Private Sub UserForm_Initialize()
Dim i As Long, j As Long
    For i = 7 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(i, 1).Font.Color = RGB(255, 0, 0) Then
           ListBox1.AddItem i
           ListBox1.List(j, 1) = Cells(i, 1)
           j = j + 1
        End If
    Next
End Sub

Private Sub ListBox1_Click()
    If ListBox1.ListIndex = -1 Then Exit Sub
    Cells(ListBox1.Value, 1).Select
End Sub
 
Варианты
1. Предварительно отсортировать данные на месте
2. Исходные данные скопировать в другой диапазон, отсортировать, вставить отсортированные в ЛистБокс, очистить временный диапазон
3. Забрать данные с листа в массив, отсортировать его, вставить в ЛистБокс
Согласие есть продукт при полном непротивлении сторон.
 
Sanja

3 вариант подойдет. Не могли бы вы помочь с реализацией? Есть код, который сортирует массив от А до Я, остается забрать данные в массив и после сортировки вставить в ЛистБокс.

Код
Private Sub SortArray(ByRef a As Variant) 
    Dim i As Long, j As Long
    Dim t As Variant
   
    'standard bubble sort loops
    For i = LBound(a) To UBound(a) - 1
        For j = i + 1 To UBound(a)
            If a(i) > a(j) Then 'change to < for descending order
                t = a(i)
                a(i) = a(j)
                a(j) = t
            End If
        Next j
    Next i
End Sub
 
Код
Private Sub UserForm_Initialize()
Dim i As Long, j As Long
    For i = 7 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(i, 1).Font.Color = RGB(255, 0, 0) Then
           ListBox1.AddItem i
           ListBox1.List(j, 1) = Cells(i, 1)
           j = j + 1
        End If
    Next

  SortArray ListBox1.List
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Ігор Гончаренко
Не работает.
 
В отладке пройдитесь, сразу станет понятно чего оно...
Код
Private Sub UserForm_Initialize()
Dim i As Long, j As Long
 Set dicTemp = CreateObject("Scripting.Dictionary")

    For i = 7 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(i, 1).Font.Color = RGB(255, 0, 0) Then
           If Not dicTemp.Exists(Cells(i, 1).Value) Then dicTemp.Add Cells(i, 1).Value, Cells(i, 1).Value
           
'           ListBox1.AddItem Cells(i, 1).Value
'           ListBox1.List(j, 1) = Cells(i, 1)
           j = j + 1
        End If
    Next
    arr = dicTemp.Items
    SortArray arr
    ListBox1.List = arr
End Sub
 
Ivan.kh
ЛистБокс пустой, странно...
 
Hashtag, одну колонку в нем сделайте ...
 
Ivan.kh
С одной колонкой заработало, но есть проблемы.
1. В ЛистБокс не добавляются одинаковые значения, только одно уникальное. Если на листе есть два Текст1, то в список пойдет только один Текст1.
2. При клике в ЛистБоксе по значению не происходит переход, а выдает ошибку в Cells(ListBox1.Value, 1).Select

Код
Private Sub ListBox1_Click()
    If ListBox1.ListIndex = -1 Then Exit Sub
    Cells(ListBox1.Value, 1).Select
End Sub
 
Вопросі не связаны с темой о сортировке
 
vikttur
Я понимаю, это я так, чтобы темы не плодить.
Поскольку код Ivan.kh, к сожалению,  влияет на работоспособность остального кода, вопрос остается открытым. Возможно существует способ сортировки массива для моего случая, работающий без ущерба для других функций кода.
 
Код
Private Sub UserForm_Initialize()
    Dim i As Long, j As Long
    Set dicTemp = CreateObject("Scripting.Dictionary")
 
    For i = 7 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(i, 1).Font.Color = RGB(255, 0, 0) Then
           If Not dicTemp.Exists(Cells(i, 1).Value & "|" & i) Then dicTemp.Add i, Cells(i, 1).Value & "|" & i
           j = j + 1
        End If
    Next
    arr = dicTemp.Items
    SortArray arr
    
    j = 0
    For Each it In arr
        m = Split(it, "|")
        ListBox1.AddItem m(UBound(m))
        ListBox1.List(j, 1) = Cells(m(UBound(m)), 1)
        j = j + 1
    Next
End Sub
 
Ivan.kh
Все работает безупречно, благодарю от души!
Страницы: 1
Читают тему (гостей: 1)
Наверх