Werte aus Userform in mehreren Tabellen per VBA abspeichern

[MdeJong]

Hallo schauan,

ich habe es hinbekommen.
Habe erst einmal für eine weitere Tabelle ausprobiert, musste einige Spalten aus dem Tabellenblatt löschen...….hatte 2 Leerspalten und dort wurde auch etwas eingetragen
Jetzt werde ich die anderen mit einbauen.

Hatte das mit der Schaltfläche 4 nicht gesehen.

Gruß
Mike

[schauan]

Hallöchen,

musste einige Spalten aus dem Tabellenblatt löschen

auf was in der Art hab ich gewartet Alternativ hätte man bei den betroffenen Spalten noch korrigieren müssen.
man hätte bei den betreffenden Einträgen z.B. noch - (iCol <> 0) * 2 oder was auch immer hinzufügen können, also dann

Cells(... , 1 + iCol - (iCol <> 0) * 2 )

hat man auf den verschiedenen Blättern unterschiedliche Leerspalten zwischen den Daten müsste man noch weiter differenzieren.


Noch ein Tipp

das häufige lfdNr + 1 kannst Du Dir sparen, wenn du die 1 gleich bei der Ermittlung von lfdNr dazu zählst.

[MdeJong]

Hallo schauan,

ok verstanden.

Jetzt habe ich die Leerspalten gelöscht....sind ja nicht notwendig :)

Gruß
Mike

[MdeJong]

Hallo schauan,

habe nun versucht die anderen Tabellen mit einzuarbeiten.

Im Tabellenblatt  "Lotto-Uhr-Samstag" und Tabellenblatt "Lotto-Uhr-Mittwoch", werden immer beide Tage abgespeichert.
Hier sollte jeweils nur Samstag oder Mittwoch abgespeichert werden.

Diese Unterscheidung macht der Code für beiden Tabellenblätter "Samstagsziehung" und Mittwochsziehung"

Genauso muss dieses für die anderen Tabellenblätter unterschieden werden.

In der beigefügten Mappe meine Buchungen in "Lotto-Uhr-Samstag" und Tabellenblatt "Lotto-Uhr-Mittwoch" zu sehen.

Gruß
Mike


  Lotto_Kampf - Kopie.xlsm (Größe: 260,74 KB / Downloads: 4)

[ralf_b]

  Lotto_Kampf - Kopie.xlsm (Größe: 256,03 KB / Downloads: 0)

ich bin zwar nicht schauan aber da ich einen Teil davon schon verbrochen habe, kannst du dir ja mal meinen Lösungsvorschlag ansehen. 

In Neue Ziehung ist jetzt eine Auswahlliste. um die richtige Liste später zu füllen. Ich hoffe es läuft ohne Fehler, da ich es nicht getestet habe.

[schauan]

Hallöchen,

ich hab jetzt die Datei von ralf nicht geladen, vielleicht geht es bei ihm in die gleiche Richtung.

Du hast jetzt ja z.B.

Code:

              Case 6
                sSheet = "Samstagziehungen"

Mach da mal

Code:

              Case 6
                sSheet = "Samstag"

draus. Mittwoch ebenso. Der Tag ist ja eigentlich der variable Teil, der Rest ziemlich fix. Unten dann

Code:

          eintragenZ sSheet & "sziehung", tbDatum, tb1, tb2, tb3, tb4, tb5, tb6, tbSZ
            eintragenZ "Lotto-Uhr-" & sSheet, tbDatum, tb1, tb2, tb3, tb4, tb5, tb6, tbSZ, Column("U") - 1
            eintragenZ "Kreuz-Tipp-" & sSheet, tbDatum, tb1, tb2, tb3, tb4, tb5, tb6, tbSZ, Column("U") - 1
            'Den Muenztipp gibt's nur Samstag?
            If sSheet = "Samstag" Then eintragenZ "Münztipp-Samstag", tbDatum, tb1, tb2, tb3, tb4, tb5, tb6, tbSZ, Column("U") - 1

[MdeJong]

Hallo schauan,

habe das mal so abgeändert wie du vorgeschlagen hast.

Bekomme die Meldung:  Laufzeitfehler 9 .... Index außerhalb des gültigen Bereichs

dann meldet sich dieser Code:

With Sheets(targetSheet)   wird gelb markiert

Code:

Sub eintragenZ(targetSheet As String, dtDate As Date, iZ1 As Integer, iZ2 As Integer, iZ3 As Integer, iZ4 As Integer, iZ5 As Integer, iZ6 As Integer, iZZ As Integer, Optional iCol As Integer = 0)
'
' Schaltfläche4_Klicken Makro

Dim lfdNr As Long
 
    With Sheets(targetSheet)
      lfdNr = .Cells(Rows.Count, 1 + iCol).End(xlUp).Row
     'lfdNr = .Cells(Rows.Count, 1).End(xlUp).Row
       .Cells(lfdNr + 1, 1 + iCol).NumberFormat = "m/d/yyyy"
       .Cells(lfdNr + 1, 1 + iCol).Value = CDate(dtDate)
       .Cells(lfdNr + 1, 2 + iCol) = Format(CStr(dtDate), "dddd")
       .Cells(lfdNr + 1, 3 + iCol) = .Cells(lfdNr, 3) + 1
       .Cells(lfdNr + 1, 4 + iCol) = iZ1
       .Cells(lfdNr + 1, 5 + iCol) = iZ2
       .Cells(lfdNr + 1, 6 + iCol) = iZ3
       .Cells(lfdNr + 1, 7 + iCol) = iZ4
       .Cells(lfdNr + 1, 8 + iCol) = iZ5
       .Cells(lfdNr + 1, 9 + iCol) = iZ6
       .Cells(lfdNr + 1, 10 + iCol) = iZZ
   
    End With
End Sub

Hier der Code mit deinen Angaben was ich verändern soll:

Code:

Private Sub cbSaveZ_Click()
Dim ctrl As Control, bCheck As Boolean

bCheck = True

For Each ctrl In Me.Controls
If TypeName(ctrl) = "TextBox" Then
    If ctrl = "" Then
        ctrl.BackColor = vbYellow
        bCheck = False
    Else
        ctrl.BackColor = vbWhite
    End If
End If
Next

If bCheck = False Then
    MsgBox "Fehlende Werte"
    Exit Sub
End If

Dim sSheet As String

  If tbDatum <> "" Then
        If IsDate(tbDatum) Then
       
            Select Case WorksheetFunction.Weekday(CDate(tbDatum), 2)
              Case 6
                sSheet = "Samstag"
              Case 3
                sSheet = "Mittwoch"
              Case Else
                tbDatum.SetFocus
                MsgBox "Datum kein Mittwoch oder Samstag"
                Exit Sub
            End Select
           
            eintragenZ sSheet & "sziehung", tbDatum, tb1, tb2, tb3, tb4, tb5, tb6, tbSZ
            eintragenZ "Lotto-Uhr-" & sSheet, tbDatum, tb1, tb2, tb3, tb4, tb5, tb6, tbSZ, Columns("U") - 1
            eintragenZ "Kreuz-Tipp-" & sSheet, tbDatum, tb1, tb2, tb3, tb4, tb5, tb6, tbSZ, Columns("U") - 1
            'Den Muenztipp gibt's nur Samstag?
            If sSheet = "Samstag" Then eintragenZ "Münztipp-Samstag", tbDatum, tb1, tb2, tb3, tb4, tb5, tb6, tbSZ, Columns("U") - 1
            'eintragenZ sSheet, tbDatum, tb1, tb2, tb3, tb4, tb5, tb6, tbSZ
            'eintragenZ "Lotto-Uhr-Samstag", tbDatum, tb1, tb2, tb3, tb4, tb5, tb6, tbSZ, Columns("Q").Column - 1
            'eintragenZ "Lotto-Uhr-Mittwoch", tbDatum, tb1, tb2, tb3, tb4, tb5, tb6, tbSZ, Columns("Q").Column - 1
            'eintragenZ Kreuz - Tipp - Samstag, tbDatum, tb1, tb2, tb3, tb4, tb5, tb6, tbSZ, Columns("U") - 1
            'eintragenZ Kreuz - Tipp - Mittwoch, tbDatum, tb1, tb2, tb3, tb4, tb5, tb6, tbSZ, Columns("U") - 1
            'eintragenZ Münztipp - Samstag, tbDatum, tb1, tb2, tb3, tb4, tb5, tb6, tbSZ, Columns("U") - 1
           
           
            For Each ctrl In Me.Controls
                If TypeName(ctrl) = "TextBox" Then ctrl = ""
            Next
             MsgBox "Ziehung eingetragen"
        Else
             MsgBox "kein Datum"
        End If
  Else
    MsgBox "Datum fehlt"
  End If
End Sub

[schauan]

Hallöchen,

wenn Du auf targetSheet klickst bzw. das in die Überwachung nimmst, was steht denn da?

[ralf_b]

Code:

'im Private Sub cbSaveZ_Click()


If tbDatum <> "" Then
        If IsDate(tbDatum) Then
       
            Select Case cboAuswahlZ
              Case "Samstagziehungen", "Mittwochsziehung"
                     icol = ""
             
              Case "Lotto-Uhr-Samstag", "Lotto-Uhr-Mittewoch"
                     icol = Columns("Q").Column - 1
               
              Case "Kreuz - Tipp - Samstag", "Kreuz - Tipp - Mittwoch"
     
                   icol = Columns("U").Column - 1
                End If
               
              Case Else
                 tbDatum.SetFocus
                 MsgBox "Datum kein Mittwoch oder Samstag"
                Exit Sub
            End Select
           
           ' sSheet = cboAuswahlZ
            'lfdNr = .Cells(Rows.Count, 1).End(xlUp).Row
           
            eintragenZ cboAuswahlZ, tbDatum, tb1, tb2, tb3, tb4, tb5, tb6, tbSZ, icol  'icol hinzugefügt, auswahlboxinhalt als Sheetname
           

[MdeJong]

Hallo ralf_,


habe meine Mappe noch einmal aufgeräumt und zugesehen, das die Spalten in der die Zahlen abgelegt werden sollen alle gleich aussehen.

Habe alle Ziehungen für Samstag und Mittwoch ab Januar 2020 neu eingegeben, dort waren Fehler.

Wo soll der Code von dir hin?

Gruß Mike


  Lotto_Kampf - Kopie.xlsm (Größe: 264,76 KB / Downloads: 1)