VBA-Programmierung in Microsoft Excel

Tutorial: Excel-Beispiele

Schaltfläche anlegen und Daten an ComboBox sortiert übergeben

Gruppe

Dialog

Bereich

ComboBox

Thema

Schaltfläche anlegen und Daten an ComboBox sortiert übergeben

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

    


Beiträge aus dem Excel-Forum zu den Themen Dialog und ComboBox