Hallo zusammen,
ich hänge hier gerade an einem kleinen Problem, folgendes ich habe eine Relativ große Arbeitsmappe mit etwa 50 Tabellenblättern und eine Eingabemaske (Userform) mit der ich Daten in diese Tabellen eintragen will, in welche Tabellen das geschehen soll findet dabei über Checkboxes statt. Funktinioniert auch alles erstmal super. Jetzt kann es aber vorkommen das an bestimmten Datensätzen nochmal etwas geändert werden soll oder diese überschrieben werden. Das funktioniert in der übergeordneten Tabelle (in der alles landet) und wenn der Datensatz in der obersten Zeile der EinzelTabelle ist, in jeder weitereren Zeile scheint er den Eintrag zwar zu finden, da er keinen neuen einträgt, aber er übernimmt die Änderungen nicht aus der Userform.
Gesamttabelle:
If CheckLP.Value = True Then
'Neuer Eintrag
szeile = 4
If TextBox5.Value = True Then
qm = TextBox5.Value 'Für die LP_Tabellen wird
ha = qm / 10000 'die qm-Eingabe in ha umgerechnet
End If
Do
If ListBox1.Text = Trim(CStr(TabelleL0.Cells(szeile, 2).Value)) Then
TabelleL0.Cells(szeile, 2).Value = Trim(CStr(TextBox1.Text))
TabelleL0.Cells(szeile, 3).Value = TextBox2.Text
TabelleL0.Cells(szeile, 4).Value = TextBox3.Text
TabelleL0.Cells(szeile, 5).Value = TextBox4.Text
TabelleL0.Cells(szeile, 6).Value = ha
TabelleL0.Cells(szeile, 7).Value = TextBox7.Text
TabelleL0.Cells(szeile, 8).Value = TextBox8.Text
TabelleL0.Cells(szeile, 9).Value = TextBox9.Text
TabelleL0.Cells(szeile, 10).Value = TextBox10.Text
TabelleL0.Cells(szeile, 11).Value = TextBox11.Text
TabelleL0.Cells(szeile, 12).Value = TextBox13.Text
If TextBox15.Text <> "" Then
reflink = TextBox15.Text
With TabelleL0
.Hyperlinks.Add Anchor:=.Range(Cells(lZeile, 14).Address(RowAbsolute:=False, ColumnAbsolute:=False)), _
Address:=CStr(reflink), _
ScreenTip:="Referenzblatt", _
TextToDisplay:="klick mich"
End With
End If
If TextBox14.Text <> "" Then
reflink = TextBox14.Text
With TabelleL0
.Hyperlinks.Add Anchor:=.Range(Cells(lZeile, 13).Address(RowAbsolute:=False, ColumnAbsolute:=False)), _
Address:=CStr(reflink), _
ScreenTip:="Dokumentation", _
TextToDisplay:="klick mich"
End With
End If
Exit Do
End If
If TabelleL0.Cells(szeile, 2).Value = "" Then
TabelleL0.Cells(szeile, 2).Value = Trim(CStr(TextBox1.Text))
TabelleL0.Cells(szeile, 3).Value = TextBox2.Text
TabelleL0.Cells(szeile, 4).Value = TextBox3.Text
TabelleL0.Cells(szeile, 5).Value = TextBox4.Text
TabelleL0.Cells(szeile, 6).Value = ha
TabelleL0.Cells(szeile, 7).Value = TextBox7.Text
TabelleL0.Cells(szeile, 8).Value = TextBox8.Text
TabelleL0.Cells(szeile, 9).Value = TextBox9.Text
TabelleL0.Cells(szeile, 10).Value = TextBox10.Text
TabelleL0.Cells(szeile, 11).Value = TextBox11.Text
TabelleL0.Cells(szeile, 12).Value = TextBox13.Text
If TextBox15.Text <> "" Then
reflink = TextBox15.Text
With TabelleL0
.Hyperlinks.Add Anchor:=.Range(Cells(lZeile, 14).Address(RowAbsolute:=False, ColumnAbsolute:=False)), _
Address:=CStr(reflink), _
ScreenTip:="Referenzblatt", _
TextToDisplay:="klick mich"
End With
End If
If TextBox14.Text <> "" Then
reflink = TextBox14.Text
With TabelleL0
.Hyperlinks.Add Anchor:=.Range(Cells(lZeile, 13).Address(RowAbsolute:=False, ColumnAbsolute:=False)), _
Address:=CStr(reflink), _
ScreenTip:="Dokumentation", _
TextToDisplay:="klick mich"
End With
End If
Exit Do
End If
szeile = szeile + 1
Loop Until TabelleL0.Cells(szeile, 2).Value = Trim(CStr(TextBox1.Text))
Speichern Einzeltabellen:
'Routine speichern L-Einzellisten
'Einzel LP
For i = 1 To 9 'Counter für Einstellige LP_Tabellen
If UserForm1.Controls("Checkbox_LP" & CStr(i)).Value = True Then
szeile = 4
Do
If ListBox1.Text = Sheets("L_0" & (CStr(i))).Cells(szeile, 2).Value Then
Sheets("L_0" & (CStr(i))).Cells(szeile, 2).Value = Trim(CStr(TextBox1.Text))
Sheets("L_0" & (CStr(i))).Cells(szeile, 3).Value = TextBox2.Text
Sheets("L_0" & (CStr(i))).Cells(szeile, 4).Value = TextBox3.Text
Sheets("L_0" & (CStr(i))).Cells(szeile, 5).Value = TextBox4.Text
Sheets("L_0" & (CStr(i))).Cells(szeile, 6).Value = ha
Sheets("L_0" & (CStr(i))).Cells(szeile, 7).Value = TextBox7.Text
Sheets("L_0" & (CStr(i))).Cells(szeile, 8).Value = TextBox8.Text
Sheets("L_0" & (CStr(i))).Cells(szeile, 9).Value = TextBox9.Text
Sheets("L_0" & (CStr(i))).Cells(szeile, 10).Value = TextBox10.Text
Sheets("L_0" & (CStr(i))).Cells(szeile, 11).Value = TextBox11.Text
Sheets("L_0" & (CStr(i))).Cells(szeile, 12).Value = TextBox13.Text
If TextBox15.Text <> "" Then
reflink = TextBox15.Text
With Sheets("L_0" & (CStr(i)))
.Hyperlinks.Add Anchor:=.Range(Cells(lZeile, 14).Address(RowAbsolute:=False, ColumnAbsolute:=False)), _
Address:=CStr(reflink), _
ScreenTip:="Referenzblatt", _
TextToDisplay:="klick mich"
End With
End If
If TextBox14.Text <> "" Then
reflink = TextBox14.Text
With Sheets("L_0" & (CStr(i)))
.Hyperlinks.Add Anchor:=.Range(Cells(lZeile, 13).Address(RowAbsolute:=False, ColumnAbsolute:=False)), _
Address:=CStr(reflink), _
ScreenTip:="Dokumentation", _
TextToDisplay:="klick mich"
End With
End If
Exit Do
End If
If Sheets("L_0" & (CStr(i))).Cells(szeile, 2).Value = "" Then
Sheets("L_0" & (CStr(i))).Cells(szeile, 2).Value = Trim(CStr(TextBox1.Text))
Sheets("L_0" & (CStr(i))).Cells(szeile, 3).Value = TextBox2.Text
Sheets("L_0" & (CStr(i))).Cells(szeile, 4).Value = TextBox3.Text
Sheets("L_0" & (CStr(i))).Cells(szeile, 5).Value = TextBox4.Text
Sheets("L_0" & (CStr(i))).Cells(szeile, 6).Value = ha
Sheets("L_0" & (CStr(i))).Cells(szeile, 7).Value = TextBox7.Text
Sheets("L_0" & (CStr(i))).Cells(szeile, 8).Value = TextBox8.Text
Sheets("L_0" & (CStr(i))).Cells(szeile, 9).Value = TextBox9.Text
Sheets("L_0" & (CStr(i))).Cells(szeile, 10).Value = TextBox10.Text
Sheets("L_0" & (CStr(i))).Cells(szeile, 11).Value = TextBox11.Text
Sheets("L_0" & (CStr(i))).Cells(szeile, 12).Value = TextBox13.Text
If TextBox15.Text <> "" Then
reflink = TextBox15.Text
With Sheets("L_0" & (CStr(i)))
.Hyperlinks.Add Anchor:=.Range(Cells(lZeile, 14).Address(RowAbsolute:=False, ColumnAbsolute:=False)), _
Address:=CStr(reflink), _
ScreenTip:="Referenzblatt", _
TextToDisplay:="klick mich"
End With
End If
If TextBox14.Text <> "" Then
reflink = TextBox14.Text
With Sheets("L_0" & (CStr(i)))
.Hyperlinks.Add Anchor:=.Range(Cells(lZeile, 13).Address(RowAbsolute:=False, ColumnAbsolute:=False)), _
Address:=CStr(reflink), _
ScreenTip:="Dokumentation", _
TextToDisplay:="klick mich"
End With
End If
Exit Do
End If
szeile = szeile + 1
Loop Until Trim(CStr(Sheets("L_0" & (CStr(i))).Cells(szeile, 2).Text)) = Trim(CStr(TextBox1.Text))
End If
Next i
Wie ihr seht verwende ich für die einzeltabellen einen Counter da der Code sonst ewig lang wäre, wie gesagt das erste Speichern funktioniert, nur Änderungen werden nich übernommen. Was ich übersehe ich? Hat mir jemanden einen Rat, ich bin für jede Hilfe dankbar.
Liebe Grüße nik
|