Gruppe
Dialog
Problem
Die Werte aus den durch Schaltflächenklick in Zeile 2 ausgewählten Spalten sollen in der ComboBox in Zeile 1 sortiert angezeigt werden.
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