VBA-Forum - Das Forum zu Microsoft VBA

VBA Excel VBA Word VBA Access VBA VBScript VB C# Objective-C C++ SQL JAVA VBA (English) Jobs Übersicht

Thema	Datum	Von Nutzer	Rating	Antwort
Speichern durch Userform in mehreren Tabellen	29.01.2015 11:45:34	nikStiles

Ansicht des Beitrags:

Von:
nikStiles

Datum:
29.01.2015 11:45:34

Views:
1199

Rating:

Antwort:

Thema:
Speichern durch Userform in mehreren Tabellen

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

Ihre Antwort

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema:		Name:		Email:

Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema	Datum	Von Nutzer	Rating	Antwort
Speichern durch Userform in mehreren Tabellen	29.01.2015 11:45:34	nikStiles