AW: Adressliste für Wolfgang
09.12.2009 06:59:54
fcs
Hallo Wolfgang,
die folgenden Anpassungen im Userform-Code fügen die Formeln ein. Ursprünglich hatte ich's schon drin. Dann deine Frage genau gelesen und die Formelerzeugung wieder in Komentare umgewandelt.
Nicht vergessen: Die Formatierung in Spalte U anzupassen - weiße Schrift auf weissen Grund ist nicht so besonders kontrastreich ;-)
Gruß
Franz
'Anzupassende Prozeduren um Code für Userform1
Private Sub Daten_Einlesen(Zeile As Long)
'Datensatz aus Tabellenblatt einlesen
With wksData
TextBox12.Text = .Cells(Zeile, 2).Text
TextBox15.Text = .Cells(Zeile, 3).Value
TextBox1.Text = .Cells(Zeile, 5).Value
TextBox2.Text = .Cells(Zeile, 6).Value
TextBox3.Text = .Cells(Zeile, 7).Value
TextBox4.Text = .Cells(Zeile, 8).Value
TextBox13.Text = .Cells(Zeile, 9).Value
TextBox5.Text = .Cells(Zeile, 10).Text
If .Cells(Zeile, 11).Value = "X" Then
Me.OptionButton1.Value = True
Else
Me.OptionButton1.Value = False
End If
TextBox6.Text = .Cells(Zeile, 12).Value
TextBox8.Text = .Cells(Zeile, 13).Value
TextBox14.Text = .Cells(Zeile, 14).Value
TextBox9.Text = .Cells(Zeile, 15).Text
TextBox10.Text = .Cells(Zeile, 16).Text
TextBox11.Text = .Cells(Zeile, 17).Text
TextBox7.Text = .Cells(Zeile, 18).Value
tboxVon.Text = .Cells(Zeile, 19).Text
tboxBis.Text = .Cells(Zeile, 20).Text
tboxDauer.Text = .Cells(Zeile, 21).Text ' ##### Ändern/vereinfachen alter Code kann auch _
bleiben
End With
ListBox1.Clear
Call DateAndTime
End Sub
Private Sub CommandButton3_Click()
Dim letzte_Zeile As Long, Zeile As Long, lngAuswahl
Dim bolGanz As Boolean, bolTeil As Boolean, bolNeu As Boolean
With wksData
If fncEingabeCheck() = True Then
' Auf doppelte Eingabe prüfen
'Prüfung ob Datensatz mit identischen Daten nochmals gespeichert werden soll
bolGanz = True: bolTeil = True: bolNeu = True
For Zeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
' Daten in Userform mit Tabelle vergleichen
If Datum(.Cells(Zeile, 2).Text) Datum(TextBox12.Text) Then bolGanz = False
If .Cells(Zeile, 3) TextBox15.Text Then bolGanz = False
If .Cells(Zeile, 4) ComboBox1.Text Then bolGanz = False: bolTeil = False 'Name
If .Cells(Zeile, 5) TextBox1.Text Then bolGanz = False: bolTeil = False 'VorName
If .Cells(Zeile, 6) TextBox2.Text Then bolGanz = False: bolTeil = False 'Adresse
If .Cells(Zeile, 7) TextBox3.Text Then bolGanz = False: bolTeil = False 'PLZ Ort
If .Cells(Zeile, 8) TextBox4.Text Then bolGanz = False
If .Cells(Zeile, 9) TextBox13.Text Then bolGanz = False
If Datum(.Cells(Zeile, 10).Text) Datum(TextBox5.Text) Then bolGanz = False
If Me.OptionButton1.Value = True Then
If .Cells(Zeile, 11) "X" Then bolGanz = False
Else
If .Cells(Zeile, 11) = "X" Then bolGanz = False
End If
If .Cells(Zeile, 12) TextBox6.Text Then bolGanz = False
If .Cells(Zeile, 13) TextBox8.Text Then bolGanz = False
If .Cells(Zeile, 14) TextBox14.Text Then bolGanz = False
' .Cells(Zeile, 15) TextBox9.Text 'WV-Datum wird in Tabelle berechent
If Datum(.Cells(Zeile, 16).Text) Datum(TextBox10.Text) Then bolGanz = False
If Datum(.Cells(Zeile, 17).Text) Datum(TextBox11.Text) Then bolGanz = False
If .Cells(Zeile, 18) TextBox7.Text Then bolGanz = False
If Zeit(.Cells(Zeile, 19).Text) Datum(tboxVon.Text) Then bolGanz = False
If Zeit(.Cells(Zeile, 20).Text) Datum(tboxBis.Text) Then bolGanz = False
If bolGanz = True And bolTeil = True Then
If MsgBox("Ein identische Datensatz existiert bereitsmit ID """ & .Cells(Zeile, 1) _
& """ bereits in Zeile """ & Zeile & """!" & vbLf & vbLf _
& "Trotzdem neu anlegen?", vbQuestion + vbYesNo, _
"Prüfung doppelte Eingabe") = vbYes Then
bolNeu = True
Exit For
Else
bolNeu = False
Exit For
End If
ElseIf bolTeil = True Then
lngAuswahl = MsgBox("Datensatz für Name, Vorname, Adresse, PLZ Ort" & vbLf & vbLf _
& "existiert mit ID """ & .Cells(Zeile, 1) & """ bereits in Zeile """ & Zeile & """! _
" & vbLf & vbLf _
& "Datensatz ändern?" & vbLf _
& "(bei ""Nein"" wird neuer Datensatz angelegt)", vbQuestion + vbYesNoCancel, _
"Prüfung doppelte Eingabe")
If lngAuswahl = vbYes Then
bolNeu = False
Call Daten_Eintragen(Zeile:=Zeile)
Exit For
ElseIf lngAuswahl = vbNo Then
bolNeu = True
Exit For
Else
' weiter prüfen
End If
End If
bolGanz = True: bolTeil = True
Next
If bolNeu = True Then
' Datensatz neu speichern
letzte_Zeile = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
'neue ID ermitteln
If letzte_Zeile = 2 Then 'Erster Eintrag in Liste
.Cells(letzte_Zeile, 1) = 1
Else
.Cells(letzte_Zeile, 1) = Application.WorksheetFunction.Max(.Range(.Cells(2, 1), _
.Cells(letzte_Zeile - 1, 1))) + 1
End If
Set rngID = .Cells(letzte_Zeile, 1)
Call Daten_Eintragen(Zeile:=letzte_Zeile)
'Formel für Wiedervorlage-Datum in Spalte O einfügen
With .Cells(letzte_Zeile, 15)
.FormulaR1C1 = _
"=IF(RC[-1]"""",DATE(YEAR(RC[1]),MONTH(RC[1])+RC[-1],DAY(RC[1])),"""")"
End With
'Formel für Dauer in Spalte U einfügen
With .Cells(letzte_Zeile, 21) 'Kommentarzeichen löschen
.FormulaR1C1 = _
"=IF(AND(RC[-1]"""",RC[-2]""""),RC[-1]-RC[-2],"""")" 'Kommentarzeichen löschen
End With 'Kommentarzeichen löschen
End If
End If
End With
Call DateAndTime
End Sub