2 Schleifen unterschiedliche Wert geben
03.03.2021 19:04:52
Stefan
Eine Datei kann ich leider nicht hochladen weil sie selbst gepackt noch über 400kb hat.
Ich habe diese Seite schon sehr viel genutzt und mir die VBA Codes die ich hier gefunden habe auf meine Bedürfnisse angepasst. Mir fehlen nun aber die Stichworte um das richtige Thema zu finden. Deshalb schreibe ich jetzt.
Es geht um eine userform welches zusätzliche Infos in eine Tabelle eintragen soll. Das tut es soweit auch, nur möchte ich gern das die Schleife 2 unterschiedliche Sachen übertragen soll. Momentan übertragen beide Schleifen das Gleiche, nämlich Datum mit Uhrzeit in Textform. Diese werden dann später in einer weiteren Tabelle ausgelesen und umgewandelt.
optfrüh, optspät und optnacht werden immer doppelt übertragen. Die erste Übertragung soll so bleiben und bei der zweiten soll der Wert datTag1 um 1 erhöht werden. Ich weiß nicht ob sowas möglich ist.
Könnte man zwischen If i = 2 Then und exit for die Änderung vornehmen und den ganzen Code nochmals dort einfügen mit dem +1 hinter datTag1?
Über ein bisschen Hilfe oder ein paar Anregungen würde ich mich sehr freuen und bedanke mich schon mal im Voraus für die Mühen. So, ich hoffe ich konnte mich verständlich genug ausdrücken, das man auch versteht was ich möchte. :-D
schöne Grüße
Stefan
Private Sub cmdEinfügen1_Click()
Dim intcoll As Integer
Dim intcol2 As Integer
Dim intcol3 As Integer
Dim intbigger1 As Integer
Dim intbigger2 As Integer
Dim intbigger3 As Integer
Dim i As Integer
If datTag1 = "" Then
GoTo unload
End If
For i = 1 To 2
intcol1 = Cells(Rows.Count, 15).End(xlUp).Row
intcol2 = Cells(Rows.Count, 16).End(xlUp).Row
intcol3 = Cells(Rows.Count, 17).End(xlUp).Row
If intcol1 > "" Then
intbigger1 = intcol1 + 1
If intcol1 > "" Then
intbigger2 = intcol2 + 1
If intcol1 > "" Then
intbigger3 = intcol3 + 1
End If
End If
End If
If optFrüh.Value = True Then
With Cells(intbigger1, 15)
.Value = datTag1 & "." & datMonat1 & "." & datJahr1 & " : " & "06:00" & .Value
With Cells(intbigger2, 16)
.Value = datTag1 & "." & datMonat1 & "." & datJahr1 & " : " & "14:00" & .Value
With Cells(intbigger3, 17)
.Value = "Ausguck"
End With
End With
End With
ElseIf optFrüh.Value = False Then
End If
If optSpät.Value = True Then
With Cells(intbigger1, 15)
.Value = datTag1 & "." & datMonat1 & "." & datJahr1 & " : " & "14:00" & .Value
With Cells(intbigger2, 16)
.Value = datTag1 & "." & datMonat1 & "." & datJahr1 & " : " & "22:00" & .Value
With Cells(intbigger3, 17)
.Value = "Ausguck"
End With
End With
End With
ElseIf optFrüh.Value = False Then
End If
If optNacht.Value = True Then
With Cells(intbigger1, 15)
.Value = datTag1 & "." & datMonat1 & "." & datJahr1 & " : " & "22:00" & .Value
With Cells(intbigger2, 16)
.Value = datTag1 +1 & "." & datMonat1 & "." & datJahr1 & " : " & "06:00" & .Value
With Cells(intbigger3, 17)
.Value = "Ausguck"
End With
End With
End With
ElseIf optFrüh.Value = False Then
End If
If i = 2 Then
Exit For
End If
Next
Application.ScreenUpdating = False
ActiveSheet.Unprotect
Range("O189:S200").Select
Selection.Delete Shift:=xlUp
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True
Application.ScreenUpdating = True
unload:
unload Me
End Sub
Private Sub userform_initialize()
With datTag1
.AddItem "01"
.AddItem "02"
.AddItem "03"
.AddItem "04"
.AddItem "05"
.AddItem "06"
.AddItem "07"
.AddItem "08"
.AddItem "09"
.AddItem "10"
.AddItem "11"
.AddItem "12"
.AddItem "13"
.AddItem "14"
.AddItem "15"
.AddItem "16"
.AddItem "17"
.AddItem "18"
.AddItem "19"
.AddItem "20"
.AddItem "21"
.AddItem "22"
.AddItem "23"
.AddItem "24"
.AddItem "25"
.AddItem "26"
.AddItem "27"
.AddItem "28"
.AddItem "29"
.AddItem "30"
.AddItem "31"
With datMonat1
.AddItem "01"
.AddItem "02"
.AddItem "03"
.AddItem "04"
.AddItem "05"
.AddItem "06"
.AddItem "07"
.AddItem "08"
.AddItem "09"
.AddItem "10"
.AddItem "11"
.AddItem "12"
With datJahr1
.AddItem "20"
.AddItem "21"
.AddItem "22"
.AddItem "23"
.AddItem "24"
.AddItem "25"
.AddItem "26"
.AddItem "27"
.AddItem "28"
.AddItem "29"
.AddItem "30"
.AddItem "31"
.AddItem "32"
.AddItem "33"
.AddItem "34"
.AddItem "35"
.AddItem "36"
.AddItem "37"
.AddItem "38"
.AddItem "39"
.AddItem "40"
.AddItem "41"
.AddItem "42"
.AddItem "43"
.AddItem "44"
.AddItem "45"
End With
End With
End With
End Sub
