AW: Inhalt von vier ComboBoxen in Tabelle auslesen
06.11.2009 01:04:44
vier
Hallo Dirk,
die Prüfung auf vorhandenen Wert muss in die For-Next-Schleife mit eingebaut werden. Ich hab noch eine Sicherheitsabfrage für das Überschreiben mit eingebaut.
Gruß
Franz
Private Sub CommandButton1_Click()
Dim wks2 As Worksheet, ZeileLetzte As Long, maxEintrag As Long, Zeile As Long
Dim Auswahl As Integer
Set wks2 = Worksheets("Tabelle2")
'Referenzwerte in tabelle2 ermitteln
With wks2
ZeileLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
maxEintrag = Application.WorksheetFunction.Max(.Range(.Cells(1, 1), _
.Cells(ZeileLetzte, 1)))
End With
With Worksheets("Tabelle1")
'Einfügezeile ermitteln
Auswahl = Worksheets("Tabelle1").ComboBox1.Value
If IsEmpty(wks2.Cells(1, 1)) Then
'1. Eintrag in Tabelle
Zeile = 1
ElseIf Auswahl > maxEintrag Then
'Eintrag am Ende einfügen
Zeile = ZeileLetzte + 1
Else
'Zeile mit nächst höherer Nummer ermitteln
For Zeile = 1 To ZeileLetzte
If wks2.Cells(Zeile, 1) = Auswahl Then
'Eintrag ist bereits vorhanden
If MsgBox("lfd. Nr. """ & Auswahl & """ ist bereits vorhanden!" & vbLf & vbLf _
& "Spalte 2: " & wks2.Cells(Zeile, 2) & vbLf _
& "Spalte 3: " & wks2.Cells(Zeile, 3) & vbLf _
& "Spalte 4: " & wks2.Cells(Zeile, 4) & vbLf & vbLf _
& "Eintrag überschreiben?", vbQuestion + vbYesNo, "Eingabewerte übertragen") _
= vbNo Then
GoTo Beenden
Else
'vorhandenen Eintrag überschreiben
Exit For
End If
ElseIf wks2.Cells(Zeile, 1) > Auswahl Then
'Leerzeile einfügen
wks2.Rows(Zeile).Insert shift:=xlShiftDown
Exit For
End If
Next
End If
'Werte in Tabelle2 eintragen
wks2.Cells(Zeile, 1) = .ComboBox1.Value
wks2.Cells(Zeile, 2) = .ComboBox2.Text
wks2.Cells(Zeile, 3) = .ComboBox3.Text
wks2.Cells(Zeile, 4) = .ComboBox4.Text
'Nach Klick auf den Weiterbutton wird ComboBox1 um +1 erhöht
.ComboBox1.Value = .ComboBox1.Value + 1
.ComboBox2.Value = ""
.ComboBox3.Value = ""
.ComboBox4.Value = ""
End With
Application.Goto wks2.Cells(Zeile, 1)
Beenden:
End Sub