Liebe Excel-Freunde
Normalerweise mache ich nix mit VBA in Excel. Wenn, dann kopiere ich nur Codes aus dem Internet.
Nun stehe ich vor dem Problem, dass ich zwei Worksheets-Change zusammenführen möchte, dies aber nicht schaffe.
Die beiden Sheets angehängt.
Könnt ihr mir helfen?
Herzlichen Dank und Gruss
mauritius5
Hi,
wieso steckst du die Codes in eine Word-Datei statt sie einfach hier rein zu kopieren (in Code-Tags)?
Deine beiden Codes sind so gut programmiert, dass du einfach den Inhalt(*) des einen kopieren und am Anfang oder Ende des anderen einfügen kannst.
(*) also alles nach der Zeile Private Sub... und vor End Sub
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("G2")) Is Nothing Then
Rows("3:8").EntireRow.Hidden = False
Columns("a:ae").EntireColumn.Hidden = False
If Range("g2").Value = "Bedarf" Then
Rows("3:8").EntireRow.Hidden = True
Columns("j:ad").EntireColumn.Hidden = True
ElseIf Range("g2").Value = "Themenverteilung" Then
Rows("3:8").EntireRow.Hidden = True
Columns("x:ad").EntireColumn.Hidden = True
End If
End If
End Sub
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngDV As Range
Dim wert_old As String
Dim wertnew As String
On Error GoTo Errorhandling
If Not Application.Intersect(Target, Range("B4:B14")) Is Nothing Then
Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
If rngDV Is Nothing Then GoTo Errorhandling
If Not Application.Intersect(Target, rngDV) Is Nothing Then
Application.EnableEvents = False
wertnew = Target.Value
Application.Undo
wertold = Target.Value
Target.Value = wertnew
If wertold <> "" Then
If wertnew <> "" Then
Target.Value = wertold & ", " & wertnew
End If
End If
End If
Application.EnableEvents = True
End If
Errorhandling:
Application.EnableEvents = True
End Sub
Ich danke dir vielmals. dies mit den Code-Tags wusste ich nicht.
Ich kriegs leider nicht hin bzw. es kommt immer eine Fehlermeldung. Wo genau muss ich es einfügen und was alles?
Hat plötzlich doch geklappt
Vielen, Vielen Dank!!!
Hi,
na z.B. so:
Code:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("G2")) Is Nothing Then
Rows("3:8").EntireRow.Hidden = False
Columns("a:ae").EntireColumn.Hidden = False
If Range("g2").Value = "Bedarf" Then
Rows("3:8").EntireRow.Hidden = True
Columns("j:ad").EntireColumn.Hidden = True
ElseIf Range("g2").Value = "Themenverteilung" Then
Rows("3:8").EntireRow.Hidden = True
Columns("x:ad").EntireColumn.Hidden = True
End If
End If
'#################################
'# Hier kommt die zweite Routine #
'#################################
Dim rngDV As Range
Dim wertold As String
Dim wertnew As String
On Error GoTo Errorhandling
If Not Application.Intersect(Target, Range("B4:B14")) Is Nothing Then
Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
If rngDV Is Nothing Then GoTo Errorhandling
If Not Application.Intersect(Target, rngDV) Is Nothing Then
Application.EnableEvents = False
wertnew = Target.Value
Application.Undo
wertold = Target.Value
Target.Value = wertnew
If wertold <> "" Then
If wertnew <> "" Then
Target.Value = wertold & ", " & wertnew
End If
End If
End If
Application.EnableEvents = True
End If
Errorhandling:
Application.EnableEvents = True
End Sub
Im übrigen war die Fehlermeldung wahrscheinlich die, dass die Variabe
wertold nicht definiert ist. Die war nämlich als
wert_old definiert. Ich habe das mal korrigiert.