AW: AW:Hinweis
15.06.2008 19:24:00
Joachim
Hi Tino,
So, nun habe ich den Code so weit gerichtet, dass der Effekt nicht mehr auftaucht. Nun habe ich noch ein kleines Problem: wenn ich die Tabelle starte, werden die Daten eingelesen. Auch wenn ich in der Combobox eine Auswahl treffe, wird sie in die aktive Zelle geschrieben. Soweit so gut.
Wenn ich nun eine andere Zelle anklicke und dort über die Combobox die GLEICHE Auswahl treffe (wie zuvor) , wird nichts in die Zele geschrieben. Wenn ich dagegen immer wieder eine andere Auswahl aus der Combobox treffe , ist das kein Problem. Aber sobald ich zwei mal die gleiche Auswahl treffe, also, wenn ich in zwei Zellen den gleichen Text reinschreiben will, wird die zweite Auswahl aus der Combobox nicht übernommen.
Kannst Du sehen, werum ?
Hier der komplette Code:
Dim Aktion As Boolean
Private Sub ComboBox1_Click()
If Aktion = True Then Exit Sub
Debug.Print ComboBox1.Text
ActiveCell.Value = ComboBox1.Value
End Sub
Private Sub ComboBox2_Click()
If Aktion = True Then Exit Sub
Debug.Print ComboBox2.Text
Sheets("Initialien").Range("H1") = Me.ComboBox2.Value
ActiveCell.Value = Sheets("Initialien").Range("I1")
End Sub
Private Sub Worksheet_Activate()
Call Fuellen
Call Fuellen2
End Sub
Sub Fuellen()
Aktion = True
Dim dic As Object
Dim xKey As Variant
Dim iRow As Long, CLetzte As Long
ComboBox1.Clear
CLetzte = IIf(IsEmpty(Range("C65536")), Range("C65536").End(xlUp).Row, 65536)
Set dic = CreateObject("scripting.dictionary")
For iRow = 1 To CLetzte
If Not IsEmpty(Cells(iRow, 3)) Then
xKey = Cells(iRow, 3).Value
dic(xKey) = 0
End If
Next
For Each xKey In dic
ComboBox1.AddItem xKey
Next
dic.RemoveAll
Set dic = Nothing
Call Sortieren1
ComboBox1.ListIndex = 0
Aktion = False
End Sub
Sub Sortieren1()
Dim Letzter As Integer, Naechster As Integer
Dim i As String
With ComboBox1
For Letzter = 0 To .ListCount - 1
For Naechster = Letzter + 1 To .ListCount - 1
If .List(Letzter) > .List(Naechster) Then
i = .List(Letzter)
.List(Letzter) = .List(Naechster)
.List(Naechster) = i
End If
Next Naechster
Next Letzter
End With
End Sub
Sub Fuellen2()
Aktion = True
Dim col As New Collection
Dim iRow As Long, aRow As Long
Dim wksA As Worksheet
Set wksA = ThisWorkbook.Worksheets("Initialien")
aRow = IIf(IsEmpty(wksA.Cells(65536, 1)), wksA.Cells(65536, 1).End(xlUp).Row, 65536)
On Error Resume Next
ComboBox2.Clear
For iRow = 1 To aRow
If Not IsEmpty(wksA.Cells(iRow, 1)) Then
col.Add wksA.Cells(iRow, 1), wksA.Cells(iRow, 1)
If Err = 0 Then
ComboBox2.AddItem wksA.Cells(iRow, 1)
Else
Err.Clear
End If
End If
Next iRow
On Error GoTo 0
Call Sortieren2
ComboBox2.ListIndex = 0
Aktion = False
End Sub
Sub Sortieren2()
Dim Letzter As Integer, Naechster As Integer
Dim i As String
With ComboBox2
For Letzter = 0 To .ListCount - 1
For Naechster = Letzter + 1 To .ListCount - 1
If .List(Letzter) > .List(Naechster) Then
i = .List(Letzter)
.List(Letzter) = .List(Naechster)
.List(Naechster) = i
End If
Next Naechster
Next Letzter
End With
End Sub