Zwei Worksheet_Change zusammenführen
#1
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


Angehängte Dateien
.docx   Codes.docx (Größe: 16,08 KB / Downloads: 2)
Antworten Top
#2
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
Gruß,
Helmut

Win10 - Office365 / MacOS - Office365
Antworten Top
#3
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 Smile

Vielen, Vielen Dank!!!
Antworten Top
#4
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.
Gruß,
Helmut

Win10 - Office365 / MacOS - Office365
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste