4.2k Aufrufe
Gefragt in Tabellenkalkulation von ponscho Mitglied (323 Punkte)
Guten Morgen Community,

wie bekomme ich zwei Private Sub Worksheet_Change Makros zusammen?

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$Q$1" Then Exit Sub
On Error Resume Next
ActiveSheet.Name = Range("Q1").Value
If Err <> 0 Then
MsgBox "Tabellenname bereits vorhanden!", vbCritical
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If IsEmpty(Target) Then Exit Sub
If Intersect(Target, Range("E5,E33,E37,E41,T8,T9,T10,T11")) _
Is Nothing Then Exit Sub
Application.EnableEvents = False
On Error GoTo ERRORHANDLER
Target = UCase(Target)
ERRORHANDLER:
Application.EnableEvents = True
End Sub


Habe es schon mit "Next" dazwischen versucht, will aber nicht recht.

Ich bedanke mich schonmal für das lesen und das sich annehmen meines Problemes!

Internette Grüsse
Mick

8 Antworten

0 Punkte
Beantwortet von hajo_zi Experte (9.1k Punkte)
Hallo Mick,


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$Q$1" Then
On Error Resume Next
ActiveSheet.Name = Range("Q1").Value
If Err <> 0 Then
MsgBox "Tabellenname bereits vorhanden!", vbCritical
End If
ElseIf Not IsEmpty(Target) Then
If Not Intersect(Target, Range("E5,E33,E37,E41,T8,T9,T10,T11")) _
Is Nothing Then
Application.EnableEvents = False
On Error GoTo ERRORHANDLER
Target = UCase(Target)
ERRORHANDLER:
Application.EnableEvents = True
End If
End If
End Sub

Gruß Hajo
0 Punkte
Beantwortet von ponscho Mitglied (323 Punkte)
Vielen Dank Hajo,

jetzt funktionierts!!

Internette Grüsse
Mick
0 Punkte
Beantwortet von ponscho Mitglied (323 Punkte)
Hallo Hajo,

bräuchte nochmals Deine Hilfe. Habe den zweiten Private Sub Worksheet-Block verkehrt gepostet, es müssten also diese beiden zusammengefügt werden. Meine Versuche sind gescheitert.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$Q$1" Then Exit Sub
On Error Resume Next
ActiveSheet.Name = Range("Q1").Value
If Err <> 0 Then
MsgBox "Tabellenname bereits vorhanden!", vbCritical
End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim strWort() As String
Dim strText As String
Dim intWortIndex As Integer

If IsEmpty(Target) Then Exit Sub

If Intersect(Target, Range("E6,E34,E38,E42,T49,T50,T51,T52,S6:AG7")) _
Is Nothing Then Exit Sub

Application.EnableEvents = False
On Error GoTo ERRORHANDLER

strWort = Split(Target, " ")

For intWortIndex = 0 To UBound(strWort)
If strWort(intWortIndex) <> "(Wwe." And strWort(intWortIndex) <> "Ehefr." And _
strWort(intWortIndex) <> "gnt." And strWort(intWortIndex) <> "sive" Then
strText = strText & " " & UCase(strWort(intWortIndex))
Else
strText = strText & " " & strWort(intWortIndex)
End If
Next
Target = Mid(strText, 2, Len(strText))
ERRORHANDLER:
Application.EnableEvents = True
End Sub


Internette Grüsse
Mick
0 Punkte
Beantwortet von hajo_zi Experte (9.1k Punkte)
Hallo Mick,


Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim strWort() As String
Dim strText As String
Dim intWortIndex As Integer
If Target.Address = "$Q$1" Then
On Error Resume Next
ActiveSheet.Name = Range("Q1").Value
If Err <> 0 Then
MsgBox "Tabellenname bereits vorhanden!", vbCritical
End If
ElseIf Not IsEmpty(Target) Then
If Not Intersect(Target, Range("E6,E34,E38,E42,T49,T50,T51,T52,S6:AG7")) _
Is Nothing Then
Application.EnableEvents = False
On Error GoTo ERRORHANDLER
strWort = Split(Target, " ")
For intWortIndex = 0 To UBound(strWort)
If strWort(intWortIndex) <> "(Wwe." And strWort(intWortIndex) <> "Ehefr." And _
strWort(intWortIndex) <> "gnt." And strWort(intWortIndex) <> "sive" Then
strText = strText & " " & UCase(strWort(intWortIndex))
Else
strText = strText & " " & strWort(intWortIndex)
End If
Next
Target = Mid(strText, 2, Len(strText))
End If
End If
ERRORHANDLER:
Application.EnableEvents = True
End Sub

Gruß Hajo
0 Punkte
Beantwortet von ponscho Mitglied (323 Punkte)
Hallo Hajo,

nochmals herzlichen Dank, funktioniert wieder super!

Internette Grüsse
Mick
0 Punkte
Beantwortet von
Bearbeitet von halfstone
Kannst du bitte einen eigene Thread für deine Anfrage aufmachen, das macht hier in dem keinen wirklichen Sinn.

Gruß Fabian

Hallo zusammen,

bin ein Anfänger was VBA angeht will aber auch einige Sub's zusammenführen, vllt kann mir hier jemand helfen?

Danke.

Private Sub CheckBox1_Click()
   ActiveCell.Select
   With Range("J4")
    If CheckBox1.Value = True Then
         .Value = "10:10"
       Else
         .Value = ""
      End If
   End With
   With Range("A4")
       If CheckBox1.Value = True Then
         .Value = "10:10"
       Else
         .Value = ""
      End If
   End With
End Sub

Private Sub CheckBox2_Click()
   ActiveCell.Select
   With Range("J4")
      If CheckBox2.Value = True Then
         .Value = "11:11"
       Else
         .Value = ""
      End If
   End With
   With Range("B4")
       If CheckBox2.Value = True Then
         .Value = "11:11"
       Else
         .Value = ""
      End If
   End With
End Sub
Private Sub CheckBox3_Click()
   ActiveCell.Select
   With Range("J4")
       If CheckBox3.Value = True Then
         .Value = "12:12"
       Else
         .Value = ""
      End If
   End With
   With Range("C4")
       If CheckBox3.Value = True Then
         .Value = "12:12"
       Else
         .Value = ""
      End If
   End With
End Sub
'####
Private Sub CheckBox4_Click()
   ActiveCell.Select
   With Range("J5")
    If CheckBox4.Value = True Then
         .Value = "10:10"
       Else
         .Value = ""
      End If
   End With
   With Range("A5")
       If CheckBox4.Value = True Then
         .Value = "10:10"
       Else
         .Value = ""
      End If
   End With
End Sub

Private Sub CheckBox5_Click()
   ActiveCell.Select
   With Range("J5")
      If CheckBox5.Value = True Then
         .Value = "11:11"
       Else
         .Value = ""
      End If
   End With
   With Range("B5")
       If CheckBox5.Value = True Then
         .Value = "11:11"
       Else
         .Value = ""
      End If
   End With
End Sub
Private Sub CheckBox6_Click()
   ActiveCell.Select
   With Range("J5")
       If CheckBox6.Value = True Then
         .Value = "12:12"
       Else
         .Value = ""
      End If
   End With
   With Range("C5")
       If CheckBox6.Value = True Then
         .Value = "12:12"
       Else
         .Value = ""
      End If
   End With
End Sub

Private Sub CheckBox7_Click()
   ActiveCell.Select
   With Range("J6")
    If CheckBox7.Value = True Then
         .Value = "10:10"
       Else
         .Value = ""
      End If
   End With
   With Range("A6")
       If CheckBox7.Value = True Then
         .Value = "10:10"
       Else
         .Value = ""
      End If
   End With
End Sub

Private Sub CheckBox8_Click()
   ActiveCell.Select
   With Range("J6")
      If CheckBox8.Value = True Then
         .Value = "11:11"
       Else
         .Value = ""
      End If
   End With
   With Range("B6")
       If CheckBox8.Value = True Then
         .Value = "11:11"
       Else
         .Value = ""
      End If
   End With
End Sub
Private Sub CheckBox9_Click()
   ActiveCell.Select
   With Range("J6")
       If CheckBox9.Value = True Then
         .Value = "12:12"
       Else
         .Value = ""
      End If
   End With
   With Range("C6")
       If CheckBox9.Value = True Then
         .Value = "12:12"
       Else
         .Value = ""
      End If
   End With
End Sub
Private Sub CheckBox10_Click()
   ActiveCell.Select
   With Range("J7")
    If CheckBox10.Value = True Then
         .Value = "10:10"
       Else
         .Value = ""
      End If
   End With
   With Range("A7")
       If CheckBox10.Value = True Then
         .Value = "10:10"
       Else
         .Value = ""
      End If
   End With
End Sub

Private Sub CheckBox11_Click()
   ActiveCell.Select
   With Range("J7")
      If CheckBox11.Value = True Then
         .Value = "11:11"
       Else
         .Value = ""
      End If
   End With
   With Range("B7")
       If CheckBox11.Value = True Then
         .Value = "11:11"
       Else
         .Value = ""
      End If
   End With
End Sub
Private Sub CheckBox12_Click()
   ActiveCell.Select
   With Range("J7")
       If CheckBox12.Value = True Then
         .Value = "12:12"
       Else
         .Value = ""
      End If
   End With
   With Range("C7")
       If CheckBox12.Value = True Then
         .Value = "12:12"
       Else
         .Value = ""
      End If
   End With
End Sub
Private Sub CheckBox13_Click()
   ActiveCell.Select
   With Range("J8")
    If CheckBox13.Value = True Then
         .Value = "10:10"
       Else
         .Value = ""
      End If
   End With
   With Range("A8")
       If CheckBox13.Value = True Then
         .Value = "10:10"
       Else
         .Value = ""
      End If
   End With
End Sub

Private Sub CheckBox14_Click()
   ActiveCell.Select
   With Range("J8")
      If CheckBox14.Value = True Then
         .Value = "11:11"
       Else
         .Value = ""
      End If
   End With
   With Range("B8")
       If CheckBox14.Value = True Then
         .Value = "11:11"
       Else
         .Value = ""
      End If
   End With
End Sub
Private Sub CheckBox15_Click()
   ActiveCell.Select
   With Range("J8")
       If CheckBox15.Value = True Then
         .Value = "12:12"
       Else
         .Value = ""
      End If
   End With
   With Range("C8")
       If CheckBox15.Value = True Then
         .Value = "12:12"
       Else
         .Value = ""
      End If
   End With
End Sub
Private Sub CheckBox16_Click()
   ActiveCell.Select
   With Range("J9")
    If CheckBox16.Value = True Then
         .Value = "10:10"
       Else
         .Value = ""
      End If
   End With
   With Range("A9")
       If CheckBox16.Value = True Then
         .Value = "10:10"
       Else
         .Value = ""
      End If
   End With
End Sub

Private Sub CheckBox17_Click()
   ActiveCell.Select
   With Range("J9")
      If CheckBox17.Value = True Then
         .Value = "11:11"
       Else
         .Value = ""
      End If
   End With
   With Range("B9")
       If CheckBox17.Value = True Then
         .Value = "11:11"
       Else
         .Value = ""
      End If
   End With
End Sub
Private Sub CheckBox18_Click()
   ActiveCell.Select
   With Range("J9")
       If CheckBox18.Value = True Then
         .Value = "12:12"
       Else
         .Value = ""
      End If
   End With
   With Range("C9")
       If CheckBox18.Value = True Then
         .Value = "12:12"
       Else
         .Value = ""
      End If
   End With
End Sub
Private Sub CheckBox19_Click()
   ActiveCell.Select
   With Range("J10")
    If CheckBox19.Value = True Then
         .Value = "10:10"
       Else
         .Value = ""
      End If
   End With
   With Range("A10")
       If CheckBox19.Value = True Then
         .Value = "10:10"
       Else
         .Value = ""
      End If
   End With
End Sub

Private Sub CheckBox20_Click()
   ActiveCell.Select
   With Range("J10")
      If CheckBox20.Value = True Then
         .Value = "11:11"
       Else
         .Value = ""
      End If
   End With
   With Range("B10")
       If CheckBox20.Value = True Then
         .Value = "11:11"
       Else
         .Value = ""
      End If
   End With
End Sub
Private Sub CheckBox21_Click()
   ActiveCell.Select
   With Range("J10")
       If CheckBox21.Value = True Then
         .Value = "12:12"
       Else
         .Value = ""
      End If
   End With
   With Range("C10")
       If CheckBox21.Value = True Then
         .Value = "12:12"
       Else
         .Value = ""
      End If
   End With
End Sub
Private Sub CheckBox22_Click()
   ActiveCell.Select
   With Range("J11")
    If CheckBox22.Value = True Then
         .Value = "10:10"
       Else
         .Value = ""
      End If
   End With
   With Range("A11")
       If CheckBox22.Value = True Then
         .Value = "10:10"
       Else
         .Value = ""
      End If
   End With
End Sub

Private Sub CheckBox23_Click()
   ActiveCell.Select
   With Range("J11")
      If CheckBox23.Value = True Then
         .Value = "11:11"
       Else
         .Value = ""
      End If
   End With
   With Range("B11")
       If CheckBox23.Value = True Then
         .Value = "11:11"
       Else
         .Value = ""
      End If
   End With
End Sub
Private Sub CheckBox24_Click()
   ActiveCell.Select
   With Range("J11")
       If CheckBox24.Value = True Then
         .Value = "12:12"
       Else
         .Value = ""
      End If
   End With
   With Range("C11")
       If CheckBox24.Value = True Then
         .Value = "12:12"
       Else
         .Value = ""
      End If
   End With
End Sub
Private Sub CheckBox25_Click()
   ActiveCell.Select
   With Range("J12")
    If CheckBox25.Value = True Then
         .Value = "10:10"
       Else
         .Value = ""
      End If
   End With
   With Range("A12")
       If CheckBox25.Value = True Then
         .Value = "10:10"
       Else
         .Value = ""
      End If
   End With
End Sub

Private Sub CheckBox26_Click()
   ActiveCell.Select
   With Range("J12")
      If CheckBox26.Value = True Then
         .Value = "11:11"
       Else
         .Value = ""
      End If
   End With
   With Range("B12")
       If CheckBox26.Value = True Then
         .Value = "11:11"
       Else
         .Value = ""
      End If
   End With
End Sub
Private Sub CheckBox27_Click()
   ActiveCell.Select
   With Range("J12")
       If CheckBox27.Value = True Then
         .Value = "12:12"
       Else
         .Value = ""
      End If
   End With
   With Range("C12")
       If CheckBox27.Value = True Then
         .Value = "12:12"
       Else
         .Value = ""
      End If
   End With
End Sub
Private Sub CheckBox28_Click()
   ActiveCell.Select
   With Range("J13")
    If CheckBox28.Value = True Then
         .Value = "10:10"
       Else
         .Value = ""
      End If
   End With
   With Range("A13")
       If CheckBox28.Value = True Then
         .Value = "10:10"
       Else
         .Value = ""
      End If
   End With
End Sub

Private Sub CheckBox29_Click()
   ActiveCell.Select
   With Range("J13")
      If CheckBox29.Value = True Then
         .Value = "11:11"
       Else
         .Value = ""
      End If
   End With
   With Range("B13")
       If CheckBox29.Value = True Then
         .Value = "11:11"
       Else
         .Value = ""
      End If
   End With
End Sub
Private Sub CheckBox30_Click()
   ActiveCell.Select
   With Range("J13")
       If CheckBox30.Value = True Then
         .Value = "12:12"
       Else
         .Value = ""
      End If
   End With
   With Range("C13")
       If CheckBox30.Value = True Then
         .Value = "12:12"
       Else
         .Value = ""
      End If
   End With
End Sub
0 Punkte
Beantwortet von halfstone Profi (17.8k Punkte)

Kannst du bitte einen eigene Thread für deine Anfrage aufmachen, das macht hier in dem keinen wirklichen Sinn.

Gruß Fabian

0 Punkte
Beantwortet von nighty Experte (6.5k Punkte)
Bearbeitet von nighty
Hallo Community

Vereinfachte Code Darstellung bei sehr vielen Checkboxen!

Private Sub CheckBox1_Click()
 Call CheckMakro(CheckBox1.Name, CheckBox1.Value)
End Sub

Private Sub CheckBox2_Click()
 Call CheckMakro(CheckBox2.Name, CheckBox2.Value)
End Sub

Sub CheckMakro(ChName As String, Zustand As Boolean)
Dim Daten(1 To 2) As String 'Dimensionierung nach Anzahl der Checkboxen ändern
Daten(1) = "A1,10:10"
Daten(2) = "B1,11:11" 'Definierung der Daten fortsetzen 3,4,etc.
If Zustand = True Then
 Range("" & Mid(Daten(Mid(ChName, 9, Len(ChName))), 1, InStr(Daten(Mid(ChName, 9, Len(ChName))), ",") - 1)) = Mid(Daten(Mid(ChName, 9, Len(ChName))), InStr(Daten(Mid(ChName, 9, Len(ChName))), ",") + 1, Len(Daten(Mid(ChName, 9, Len(ChName)))))
Else
 Range("" & Mid(Daten(Mid(ChName, 9, Len(ChName))), 1, InStr(Daten(Mid(ChName, 9, Len(ChName))), ",") - 1)) = ""
End If
End Sub

Beliebige Ereignissprozeduren lassen sich mit der selben Structur vereinfachen und produzieren so einen sehr guten schnellen Überblick.

Gruß Nighty
...