zwei Worksheet_Change kombinieren (fcs)
05.12.2013 11:04:17
Dip
Den Versuch die zwei folgenden Makros zu kombinieren, habe ich leider nicht geschafft. Es handelt sich um zwei voneinander unabhängige Makros.
Makro Nr. 2 wurde vom engagierten Forumsmitglied Franz (fcs) entwickelt. Evtl. wüsstest Du Franz wie man am besten vorgehen sollte!?
(Ps. die Fehlermeldung mit dem #NV im PSP Code habe ich mittels ISTFEHLER eliminiert, nun funktioniert Dein Makro einwandfrei, Danke nochmals Franz :-)... Konnte auf den alten Forumseintrag irgendwie nicht mehr antworten)
1:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim oldVal As String
Dim newVal As String
Dim lUsed As Long
If Target.Count > 1 Then GoTo exitHandler
On Error Resume Next
Set rngDV = Cells.SpecialCells(xlCellTypeAllValidation)
On Error GoTo exitHandler
If rngDV Is Nothing Then GoTo exitHandler
If Intersect(Target, rngDV) Is Nothing Then
'do nothing
Else
Application.EnableEvents = False
newVal = Target.Value
Application.Undo
oldVal = Target.Value
Target.Value = newVal
If Target.Column = 3 Then
If oldVal = "" Then
'do nothing
Else
If newVal = "" Then
'do nothing
Else
lUsed = InStr(1, oldVal, newVal)
If lUsed > 0 Then
If Right(oldVal, Len(newVal)) = newVal Then
Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
Else
Target.Value = Replace(oldVal, newVal & ", ", "")
End If
Else
Target.Value = oldVal _
& ", " & newVal
End If
End If
End If
End If
End If
exitHandler:
Application.EnableEvents = True
End Sub
2:
Private Const gZeileMonat As Long = 7 'Zeile mit den Monaten
Private Const gZeileProj1 As Long = 12 'Zeile mit 1. Projekt
Private Const gSpalteTotal As Long = 88 'Spalte C - Eingabespalte mit Total
Private Const gSpalteJan1 As Long = 90 'Spalte E - Einagbespalte 1. Januar-Monat
Private Const iStufen As Integer = 9 'Anzahl Gliederungsstufen
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lngZeile1 As Long, lngZeile2 As Long, lngZeile As Long
Dim rngZelle As Range
On Error GoTo Beenden
Select Case Target.Column
Case gSpalteTotal, Is >= gSpalteJan1
Select Case Target.Row
Case Is >= gZeileProj1
If Me.ToggleButton1 = False Then
For Each rngZelle In Target.Cells
If Not IsNumeric(rngZelle.Value) Then
MsgBox "Als Eingabe sind in diesem Zellbereich nur Zahlen zulässig!" & vbNewLine & _
"Bitte Eingabe korrigieren oder löschen!", , _
"Daten zu Projekt neu berechnen"
Exit Sub
End If
Next
'1. Zeile Projekt ermitteln
lngZeile = Target.Row
lngZeile1 = lngZeile
Do Until Me.Cells(lngZeile1 - 1, 1) = ""
lngZeile1 = lngZeile1 - 1
Loop
'Letzte Zeile Projekt ermitteln
lngZeile = Target.Row
lngZeile2 = lngZeile
Do Until Me.Cells(lngZeile2 + 1, 1) = ""
lngZeile2 = lngZeile2 + 1
Loop
Call AdditionenVBAProjekt(Zeile1:=lngZeile1, Zeile2:=lngZeile2)
End If
End Select
End Select
Beenden:
With Err
Select Case .Number
Case 0 'alles OK
Case 13
MsgBox "#NV! (PSP-Element) - Bitte zuerst die Projektstruktur definieren damit Werte _
summiert werden können.", vbInformation + vbOKOnly, "Prüfung vollständige Projektstruktur"
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description, _
vbInformation + vbOKOnly, "Makro: Worksheet_Change"
End Select
End With
End Sub
Beste Grüsse
Dip