Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Schaltfläche anlegen und Daten an ComboBox sortiert übergeben

Gruppe

ComboBox

Problem

Die Werte aus den durch Schaltflächenklick in Zeile 2 ausgewählten Spalten sollen in der ComboBox in Zeile 1 sortiert angezeigt werden.

Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.

StandardModule: basMain

Sub CreateButtons()
   Dim btn As Button
   Dim iBtn As Integer
   ActiveSheet.Buttons("NewButtons").Delete
   For iBtn = 1 To 26
      Set btn = ActiveSheet.Buttons.Add( _
         Cells(2, iBtn).Left, _
         Cells(2, iBtn).Top, _
         Cells(2, iBtn).Width, _
         Cells(2, iBtn).Height)
      btn.Caption = Chr(iBtn + 64)
      btn.OnAction = "FillCbo"
   Next iBtn
End Sub

Sub ShowAll()
   Dim cbo As Object
   Dim arr() As Variant
   Dim iRow As Integer, iCol As Integer, iCounter As Integer
   iRow = 3
   iCol = 1
   Do Until IsEmpty(Cells(iRow, iCol))
      Do Until IsEmpty(Cells(iRow, iCol))
         iCounter = iCounter + 1
         ReDim Preserve arr(1 To iCounter)
         arr(iCounter) = Cells(iRow, iCol).Value
         iRow = iRow + 1
      Loop
      iRow = 3
      iCol = iCol + 1
   Loop
   If iCounter > 0 Then
      Call QuickSort(arr)
      With wksValues.cboValues
         .List = arr
         .ListIndex = 0
      End With
   End If
End Sub

Sub FillCbo()
   Dim cbo As Object
   Dim arr() As Variant
   Dim iCounter As Integer, iRow As Integer, iCol As Integer
   Set cbo = wksValues.cboValues
   iCol = wksValues.Buttons(Application.Caller).TopLeftCell.Column
   iRow = Cells(Rows.Count, iCol).End(xlUp).Row - 2
   cbo.Clear
   If iRow > 2 Then
      ReDim arr(1 To iRow)
      For iCounter = 3 To iRow + 2
         arr(iCounter - 2) = Cells(iCounter, iCol).Value
      Next iCounter
      Call QuickSort(arr)
      With cbo
         .List = arr
         .ListIndex = 0
      End With
   End If
End Sub

Sub QuickSort(ByRef VA_array, Optional V_Low1, Optional V_high1)
    On Error Resume Next
    Dim V_Low2, V_high2, V_loop As Integer
    Dim V_val1, V_val2 As Variant
    If IsMissing(V_Low1) Then
        V_Low1 = LBound(VA_array, 1)
    End If
    If IsMissing(V_high1) Then
        V_high1 = UBound(VA_array, 1)
    End If
    V_Low2 = V_Low1
    V_high2 = V_high1
    V_val1 = VA_array((V_Low1 + V_high1) / 2)
    While (V_Low2 <= V_high2)
        While (VA_array(V_Low2) < V_val1 And _
            V_Low2 < V_high1)
            V_Low2 = V_Low2 + 1
        Wend
        While (VA_array(V_high2) > V_val1 And _
            V_high2 > V_Low1)
            V_high2 = V_high2 - 1
        Wend
        If (V_Low2 <= V_high2) Then
            V_val2 = VA_array(V_Low2)
            VA_array(V_Low2) = VA_array(V_high2)
            VA_array(V_high2) = V_val2
            V_Low2 = V_Low2 + 1
            V_high2 = V_high2 - 1
        End If
    Wend
    If (V_high2 > V_Low1) Then Call _
        QuickSort(VA_array, V_Low1, V_high2)
    If (V_Low2 < V_high1) Then Call _
        QuickSort(VA_array, V_Low2, V_high1)
End Sub