AW: Wenn Dann mit mehreren Bedingungen
04.09.2018 09:56:51
Armin
Moin Ransi,
also das Konstukt Drumherum sieht so aus
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ErrExit
Dim c As Range
Dim mPSP As String
Dim mCostCenter As Double
Const myCol = 10 'Eingabespalte anpassen!
mPSP = Worksheets("Hilfstabellen").Range("F2")
mCostCenter = Worksheets("Hilfstabellen").Range("E2")
If Not Intersect(Target, Me.Columns(myCol)) Is Nothing Then
Application.EnableEvents = False
For Each c In Intersect(Target, Me.Columns(myCol))
If IsEmpty(c.Offset(, 4)) And IsEmpty(c.Offset(, 7)) Then
c.Offset(, 4).Value = IIf(IsEmpty(c), Empty, mCostCenter) _
'Kostenstelle setzen
If c.Offset(, -2) >= 1000 Then c.Offset(, 5).Value = IIf(IsEmpty(c), Empty, mPSP) _
'PSP Element stzen
c.Offset(, 7).Value = IIf(IsEmpty(c), Empty, Application.UserName) _
'Bearbeiter setzen
End If
Next
End If
'For i = 8 To Cells(Rows.Count, 1).End(xlUp).Row
'If Cells(i, 8) >= 1000 And Cells(i, 14) 201612 Then
' sPSP = Application.InputBox(Prompt:="PSP Element eingeben", Title:="Abfrage", Type:=2)
' ActiveCell.Value = sPSP
'End If
'Next i
aufräumen:
Application.EnableEvents = True
Exit Sub
ErrExit:
'Fehlerbehandlung
Resume aufräumen
End Sub
Gruß aus Hamburg
Armin