Как отсортировать два списка ListBox в пользовательской форме Excel, элементы которых могут перемещаться друг к другу и обратно - PullRequest
0 голосов
/ 13 июля 2020

Обычно я заполняю ListBoxes именами заголовков столбцов, которые я выбираю для удаления. В ListBox у меня есть два столбца, поэтому первый отслеживает порядок, а второй показывает имя заголовка. Я хочу отсортировать по первому столбцу, чтобы сохранить порядок, если элементы перемещаются вперед и назад.

Методы пузырьковой сортировки, которые я использовал, дают такой результат, как (1,10,11,12,13, 2,3,4,5,6,7,8,9).

Изображение пользовательской формы

Итак, вот мой код, заполняющий поле списка.

Private Sub UserForm_Initialize()
Dim colCount As Integer
Dim i As Integer

colCount = Cells(1, Columns.Count).End(xlToLeft).Column 'How many headers to work with

For i = 0 To colCount - 1

 lBox_headersKeep.AddItem i
 lBox_headersKeep.List(i, 1) = Cells(1, i + 1)  'Add headers to this array
Next i

End Sub

А вот мой код, перемещающий элементы вперед и назад. Я бы хотел, чтобы сортировка произошла здесь.

Private Sub cmd_sellectionRight_Click() 'move item from Left ListBox to Right
  Dim i As Long
  Dim c As Integer
  For i = 0 To lBox_headersKeep.listCount - 1 'start the loop to move right
   c = lBox_headersRemove.listCount 'get count in lBox_headersRemove
    If lBox_headersKeep.Selected(i) Then
        lBox_headersRemove.AddItem lBox_headersKeep.List(i)
        lBox_headersRemove.List(c, 1) = lBox_headersKeep.List(i, 1)
      lBox_headersKeep.RemoveItem i
    End If
  Next
End Sub

Private Sub cmd_sellectionLeft_Click() 'move item from Right ListBox back to Left
  Dim i As Long
  Dim c As Integer
  For i = 0 To lBox_headersRemove.listCount - 1 'start the loop to move left
   c = lBox_headersKeep.listCount 'get count in lBox_headersKeep
    If lBox_headersRemove.Selected(i) Then
        lBox_headersKeep.AddItem lBox_headersRemove.List(i)
        lBox_headersKeep.List(c, 1) = lBox_headersRemove.List(i, 1)
      lBox_headersRemove.RemoveItem i
    End If
  Next
End Sub

EDIT !!! Я должен был добавить это для начала, но я использую именно эту пузырьковую сортировку.

Public Function BubbleSrt(ArrayIn, Ascending As Boolean)

Dim SrtTemp As Variant
Dim i As Long
Dim j As Long


If Ascending = True Then
    For i = LBound(ArrayIn) To UBound(ArrayIn)
         For j = i + 1 To UBound(ArrayIn)
             If ArrayIn(i) > ArrayIn(j) Then
                 SrtTemp = ArrayIn(j)
                 ArrayIn(j) = ArrayIn(i)
                 ArrayIn(i) = SrtTemp
             End If
         Next j
     Next i
Else
    For i = LBound(ArrayIn) To UBound(ArrayIn)
         For j = i + 1 To UBound(ArrayIn)
             If ArrayIn(i) < ArrayIn(j) Then
                 SrtTemp = ArrayIn(j)
                 ArrayIn(j) = ArrayIn(i)
                 ArrayIn(i) = SrtTemp
             End If
         Next j
     Next i
End If

BubbleSrt = ArrayIn

End Function

1 Ответ

0 голосов
/ 13 июля 2020

Это работает для 2D-массива из списка:

'Sort a 2D array ascending or descending
'  sortIndex should use the same base as the input array,
'    so sortIndex = 0 for the first column where array base is zero
Public Function BubbleSort2D(ArrayIn, sortIndex As Long, _
                           Optional AsNumbers As Boolean = True, _
                           Optional Ascending As Boolean = True)
    
    Dim i As Long, a, b, tmp
    Dim j As Long, c As Long
    
    For i = LBound(ArrayIn, 1) To UBound(ArrayIn, 1)
         For j = i + 1 To UBound(ArrayIn, 1)
            
            If AsNumbers Then
                a = CDbl(ArrayIn(i, sortIndex))
                b = CDbl(ArrayIn(j, sortIndex))
            Else
                a = ArrayIn(i, sortIndex)
                b = ArrayIn(j, sortIndex)
            End If
             
            If IIf(Ascending, a > b, a < b) Then
                For c = LBound(ArrayIn, 2) To UBound(ArrayIn, 2)
                    tmp = ArrayIn(j, c)
                    ArrayIn(j, c) = ArrayIn(i, c)
                    ArrayIn(i, c) = tmp
                Next c
             End If
         Next j
     Next i
    BubbleSort2D = ArrayIn
End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...