Hilfe... ich schaffe es einfach nicht...
15.02.2010 18:45:50
amintire
Hallo Christian...
ich hab jetzt 9 ComboBoxen. Hab den Code nun so umgebaut nur leider kommen die Eingaben nicht in die entsprechenenden Zellen... Was mach ich falsch?
Option Explicit
Private Sub Speichern_Click()
Dim i As Long, j As Long
With Sheets("Liste Mitarbeiter")
i = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(i, 1) = Me.ComboBox1
i = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
.Cells(i, 2) = Me.ComboBox2
i = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
.Cells(i, 3) = Me.ComboBox3
i = .Cells(.Rows.Count, 4).End(xlUp).Row + 1
.Cells(i, 4) = Me.ComboBox4
i = .Cells(.Rows.Count, 5).End(xlUp).Row + 1
.Cells(i, 5) = Me.ComboBox5
i = .Cells(.Rows.Count, 21).End(xlUp).Row + 1
.Cells(i, 20) = Me.ComboBox8
i = .Cells(.Rows.Count, 21).End(xlUp).Row + 1
.Cells(i, 21) = Me.ComboBox9
For j = 1 To 24
.Cells(i, j + 5) = Me.Controls("TextBox" & j)
Next
.Cells(i, 1).Resize(, 33).Borders.LineStyle = 1
.Cells(i, 1).Resize(, 33).Borders.Weight = 1
With Sheets("Liste Mitarbeiter")
i = .Cells(.Rows.Count, 10).End(xlUp).Row + 1
.Cells(i, 10) = Me.ComboBox6
i = .Cells(.Rows.Count, 11).End(xlUp).Row + 1
.Cells(i, 11) = Me.ComboBox7
End With
End With
If ComboBox2 = "" Then
MsgBox ("Bitte Namen eingeben")
ComboBox2.SetFocus
End If
ActiveCell.Offset(1, 0).Range("A1").Select
Application.ScreenUpdating = True
Unload Me
End Sub
'Combobox Auswahl für Daten ohne doppelte Einträge
Private Sub UserForm_Initialize()
'ComboBoxes füllen ohne doppelte Einträge
'Annahme: alle Spalten haben die gleiche Anzahl von Einträgen
'Annahme: die Werte aus Spalte A, B und F sollen in ComboBox1, 2, und 3 eingelesen _
werden:
Dim hsh1 As Object, hsh2 As Object, hsh3 As Object, hsh4 As Object, hsh5 As Object, _
hsh6 As Object, hsh7 As Object, hsh8 As Object, hsh9 As Object
Dim i As Long, lngLR As Long
Set hsh1 = CreateObject("Scripting.Dictionary")
Set hsh2 = CreateObject("Scripting.Dictionary")
Set hsh3 = CreateObject("Scripting.Dictionary")
Set hsh4 = CreateObject("Scripting.Dictionary")
Set hsh5 = CreateObject("Scripting.Dictionary")
Set hsh6 = CreateObject("Scripting.Dictionary")
Set hsh7 = CreateObject("Scripting.Dictionary")
Set hsh8 = CreateObject("Scripting.Dictionary")
Set hsh9 = CreateObject("Scripting.Dictionary")
With Sheets("Liste Mitarbeiter")
For i = 5 To .Cells(.Rows.Count, 1).End(xlUp).Row 'letzte Zeile in Spalte A
hsh1(.Cells(i, 1).Text) = 0 '1 = Spalte A
hsh2(.Cells(i, 2).Text) = 0 '2 = Spalte B
hsh3(.Cells(i, 3).Text) = 0 '6 = Spalte F
hsh4(.Cells(i, 4).Text) = 0 '1 = Spalte A
hsh5(.Cells(i, 5).Text) = 0 '2 = Spalte B
hsh6(.Cells(i, 10).Text) = 0 '6 = Spalte F
hsh7(.Cells(i, 11).Text) = 0 '1 = Spalte A
hsh8(.Cells(i, 20).Text) = 0 '2 = Spalte B
hsh9(.Cells(i, 21).Text) = 0 '6 = Spalte F
Next
End With
Me.ComboBox1.List = Application.Transpose(hsh1.Keys)
Me.ComboBox2.List = Application.Transpose(hsh2.Keys)
Me.ComboBox3.List = Application.Transpose(hsh3.Keys)
Me.ComboBox4.List = Application.Transpose(hsh4.Keys)
Me.ComboBox5.List = Application.Transpose(hsh5.Keys)
Me.ComboBox6.List = Application.Transpose(hsh6.Keys)
Me.ComboBox7.List = Application.Transpose(hsh7.Keys)
Me.ComboBox8.List = Application.Transpose(hsh8.Keys)
Me.ComboBox9.List = Application.Transpose(hsh9.Keys)
Set hsh1 = Nothing
Set hsh2 = Nothing
Set hsh3 = Nothing
Set hsh4 = Nothing
Set hsh5 = Nothing
Set hsh6 = Nothing
Set hsh7 = Nothing
Set hsh8 = Nothing
Set hsh9 = Nothing
End Sub
Private Sub Schließen_Click()
Unload Me
End Sub
Hoffe du kannst mir helfen...
Gruß Amina