VBA für echte Profis

Hallo zusammen,
Mir wurde hier schon einmal sehr geholfen allerdings bräuchte ich nochmals eure Hilfe. Ich konnte mir zwar einzelne Code Fragmente abschreibe/abändern aber für das folgende reichen meine Kenntnisse bei weitem nicht aus. Ich bin mir nicht einmal sicher ob so etwas überhaut machbar ist.
Wenn man in "G4" RE eintippt sollte folgendes geschehen (Worksheet_Change)
- In "H4" sollte automatisch die "83" erscheinen.
- in "i4" sollte immer automatisch die, in der darüberlegenden, Zahl mit 1 addiert werden und das Ergebnis angezeigt werden.
- in "J4" sollte immer automatisch die, in der darüberlegenden, Zahl mit 0 addiert werden und das Ergebnis angezeigt werden.
Wenn man in "G4" GU eintippt sollte folgendes geschehen.
- In "H4" sollte automatisch die "83" erscheinen.
- in "i4" sollte immer automatisch die, in der darüberlegenden, Zahl mit 0 addiert werden und das Ergebnis angezeigt werden.
- in "J4" sollte immer automatisch die, in der darüberlegenden, Zahl mit 1 addiert werden und das Ergebnis angezeigt werden.
- in "K4" sollte immer automatisch die, in der darüberlegenden, Zahl mit -1 multipliziert werden und das Ergebnis angezeigt werden.
- in "M4", "N4" und "S4" sollte automatisch das aktuelle Datum erscheinen
- in "R4" sollte automatisch der Inhalt aus "K4" (also R4=K4) stehen
- in "N4" sollte automatisch der Inhalt aus "N3" erscheinen
- in "B5"; "C5";"D5";"E5"; sollte das gleiche stehen wie in den darüber liegenden Zellen ("B4"; "C4";"D4";"E4";)
- in "G5" sollte "RE-02" stehen
- in "H5" sollte automatisch die "83" stehen
- in "i5" sollte automatisch die, in der darüberlegenden, Zahl mit 0 addiert werden und das Ergebnis angezeigt werden.
- in "J5" sollte immer automatisch die, in der darüberlegenden, Zahl mit 1 addiert werden und das Ergebnis angezeigt werden.
Vielen Dank euch.
Ich hoffe hier gibt's jemand der mir hier helfen kann.
LG Moritz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Address = "$G$4" Then If Target.Value = "RE" Then Range("H4").Value = 83 Range("I4").Value = Range("I4").Offset(-1, 0).Value + 1 Range("J4").Value = Range("J4").Offset(-1, 0).Value + 1 ElseIf Target.Value = "GU" Then Range("H4").Value = 83 Range("I4").Value = Range("I4").Offset(-1, 0).Value + 0 Range("J4").Value = Range("J4").Offset(-1, 0).Value + 1 Range("K4").Value = Range("K4").Offset(-1, 0).Value * -1 Range("M4:N4").Value = Date Range("S4").Value = Date Range("R4").Value = Range("K4").Value Range("N4").Value = Range("N4").Offset(-1, 0).Value Range("B5").Value = Range("B4").Value Range("C5").Value = Range("C4").Value Range("D5").Value = Range("D4").Value Range("E5").Value = Range("E4").Value Range("G5").Value = "RE-02" Range("H5").Value = 83 Range("I5").Value = Range("I4").Value + 0 Range("J5").Value = Range("J4").Value + 1 End If End If Application.EnableEvents = True End Sub

Hallo Moritz,
teste mal:

Private Sub Worksheet_Change(ByVal Target As Range)
'Quelle: Frank Kabel
If Target.Cells.Count > 1 Then Exit Sub
If Intersect(Target, Me.Range("E3:AH44")) Is Nothing Then Exit Sub
On Error GoTo CleanUp:
With Target
If .Value  "" Then
Application.EnableEvents = False
.Value = UCase(.Value)
End If
End With
CleanUp:
Application.EnableEvents = True
If Target.Column = 12 And Target.Row >= 3 And Target.Count = 1 Then
If IsNumeric(Target.Offset(, -1)) Then
If Target.Value = 7.7 Then
Target = Target.Offset(, -1) * 1.077
ElseIf Target.Value = 19 Then
Target = Target.Offset(, -1) * 1.19
End If
Else
Application.EnableEvents = False
Target = ""
Application.EnableEvents = True
MsgBox "Es ist kein Zahlenwert in Spalte K."
End If
End If
If Target.Column = 7 And Target.Row > 3 Then
If UCase(Target) = "GE" Then
Application.EnableEvents = False
Target.Offset(, 1) = 83
Target.Offset(, 2) = Target.Offset(-1, 2) + 1
Target.Offset(, 3) = Target.Offset(-1, 3)
Application.EnableEvents = True
ElseIf UCase(Target) = "GU" Then
Application.EnableEvents = False
Target.Offset(, 1) = 83
Target.Offset(, 2) = Target.Offset(-1, 2)
Target.Offset(, 3) = Target.Offset(-1, 3) + 1
Target.Offset(, 4) = Target.Offset(-1, 4) * (-1)
Target.Offset(, 6) = Date
Target.Offset(, 8) = Date
Target.Offset(, 12) = Date
Target.Offset(, 11) = Target.Offset(, 4)
Target.Offset(, 7) = Target.Offset(-1, 7)
Target.Offset(, -5).Resize(1, 3).Value = Target.Offset(-1, -5).Resize(1, 3).Value
Target.Offset(1) = "RE-02"
Target.Offset(1, 1) = 83
Target.Offset(1, 1) = Target.Offset(, 1)
Target.Offset(1, 3) = Target.Offset(, 3)
Application.EnableEvents = True
End If
End If
If Not Target.Column = 5 Then Exit Sub
If Not Target.Row > 2 Then Exit Sub
Select Case LCase(Target.Value)
Case "hamu"
Me.Cells(Target.Row, 6).Value = "BP"
Case "cwi", "mass", "casc", "scbe"
Me.Cells(Target.Row, 6).Value = "BS"
Case "unul", "wert"
Me.Cells(Target.Row, 6).Value = "MUE"
Case "spt"
Me.Cells(Target.Row, 6).Value = "intern"
Case Else
Me.Cells(Target.Row, 6).Value = "XXX"
End Select
End Sub

Gruß Werner

Beliebteste Forumthreads (12 Monate)

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread