Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1104to1108
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Private Sub Worksheet_Change

Private Sub Worksheet_Change
Larissa
Hallo VBA-Künstler,
Ich habe in meiner Excelmappe schon ein längeres
Private Sub Worksheet_Change(ByVal Target As Range)
auf dem ersten Tabellenblatt eingebaut.
Bisher habe ich es nur so hinbekommen, dass die direkte Spalte angesprochen wird, in der man gerade etwas einträgt.
Jetzt benötige ich noch eine Funktion dazu und bekomme das einfach nicht gebacken.
So sollte es sein:
Wenn in Spalte D ein '/ eingetragen ist, soll gar nichts passieren (Exit Sub)
Wenn in Spalte A, B, C, E, F, G, H, I, J eine nachträgliche Änderung vorgenommen wird sollen je nachdem, was in Spalte D steht, bestimmte Makros ausgelöst werden. Z.B.
Case "Einkauf"
Call Einkauf
Case "Fracht"
Call Fracht
Case "Kurier"
Call Kurier
Case "Andere"
Call Andere
Ich hoffe, Ihr könnt mir dabei weiterhelfen und freue mich schon auf Lösungsvorschläge.
Viele Grüße,
Larissa
AW: Private Sub Worksheet_Change
05.10.2009 19:39:36
Matthias
Hallo
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column = 6 Then
Select Case Target
Case "EUR"
Target.Offset(0, 1).NumberFormat = "#,##0.00 €"
Case "USD"
Target.Offset(0, 1).NumberFormat = "#,##0.00 [$$-409]"
End Select
End If
If Target.Column = 1 Or Target.Column = 2 Or Target.Column = 3 Or Target.Column = 5 Or  _
Target.Column = 6 Or Target.Column = 7 Or Target.Column = 8 Or Target.Column = 9 Or Target.Column = 10 Then
    Select Case Cells(Target.Row, 4)
Case "Einkauf"
MsgBox "Call EK_"
Case "Fracht"
MsgBox "Call Fracht_"
Case "Kurier"
MsgBox "Call Kurier_"
Case "Andere"
MsgBox "Call Andere_"
End Select
End If
End Sub
besser wäre es Du verlinkst immer zum Quellbeitrag.
Gruß Matthias
Anzeige
Danke Matthias
05.10.2009 22:43:09
Larissa
Hallo Matthias,
die Idee mit der Msg Box habe ich übernommen, das passt gerade sehr gut -Vielen Dank!!
-- Quellbeitrag werde ich mir merken.
Viele Grüße,
Larissa
2 Versionen zum testen...
05.10.2009 19:55:30
Tino
Hallo,
kannst ja mal so testen.
Eine Frage noch, wenn Eingabe mehrmals in einer Zeile vorkommt,
soll dann auch mehrmals die Call... ausgeführt werden oder nur einmal für jede Zeile.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range

With ActiveSheet.UsedRange
 Set Bereich = Intersect(Union(.Columns("A:C"), .Columns("E:J")), Target)
End With

 If Not Bereich Is Nothing Then
    For Each Bereich In Bereich
        If Bereich.Row > 1 Then 'ohne überschrift Zeile 1 
               Select Case Cells(Bereich.Row, 4).Value
                    Case "Einkauf": Call Einkauf
                    Case "Fracht": Call Fracht
                    Case "Kurier": Call Kurier
                    Case "Andere": Call Andere
               End Select
        End If
    Next Bereich
 End If

End Sub
Wenn oberes nicht zutrifft und für jede Zeile nur einmal ein Makro laufen soll versuche es mal hiermit.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range

With ActiveSheet.UsedRange
 Set Bereich = Intersect(Union(.Columns("A:C"), .Columns("E:J")), Target)
End With

 If Not Bereich Is Nothing Then
    For Each Bereich In Bereich.Columns(1)
        If Bereich.Row > 1 Then 'ohne überschrift Zeile 1 
               Select Case Cells(Bereich.Row, 4).Value
                    Case "Einkauf": Call Einkauf
                    Case "Fracht": Call Fracht
                    Case "Kurier": Call Kurier
                    Case "Andere": Call Andere
               End Select
        End If
    Next Bereich
 End If

End Sub
Gruß Tino
Anzeige
Danke, das klappt wunderbar :-)
05.10.2009 22:32:06
Larissa
Hallo,
vielen Dank für die tollen Makros. Die funktionieren super.
Liebe Grüße, Larissa
@ Tino
06.10.2009 09:28:00
Andre´
Hallo Tino,
habe Dein Bsp. getestet und es funktioniert.
Wenn oberes nicht zutrifft und für jede Zeile nur einmal ein Makro laufen soll versuche es mal hiermit.
was ist hier anders als im 1. Bsp.?
Würde gern eine Lösung haben, wo das Makro für jede Zeile einmal läuft.
Vielen Dank im Voraus!
MFG Andre
Nochmal angepasst
06.10.2009 16:08:25
Tino
Hallo,
um es wirklich nur immer für eine Zeile zu machen, muss man den Code noch etwas anpassen.
Jetzt können die Zellen auch auseinander liegen (mehrere Areas) und es wird für jede Zeile immer nur
einmal die Select Case erreicht.
Eine weitere Voraussetzung für diesen Code ist,
dein Usedrange (Benutzter Bereich) muss in A1 beginnen und mindestens bis Spalte J gehen, dies wird in der Regel schon durch die Überschrift in diesem Bereich gewehrleistet.
Ist Dein Usedrange anders, muss der Code wieder angepasst werden.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Bereich As Range, rTemp As Range
Dim i As Integer, ii As Integer
Dim booNot As Boolean

With ActiveSheet.UsedRange
 Set Bereich = Intersect(Union(.Range("A:C"), .Range("E:J")), Target)
End With

 If Not Bereich Is Nothing Then
  For i = 1 To Bereich.Areas.Count
        
        For Each rTemp In Bereich.Areas(i).Columns(1).Cells
                
                If i > 1 Then
                  For ii = 1 To i - 1
                       booNot = (Not Intersect(Bereich.Areas(ii), rTemp.EntireRow) Is Nothing)
                       If booNot Then Exit For
                  Next ii
                End If
            
                If rTemp.Row > 1 And Not booNot Then  'ohne überschrift Zeile 1 
                       Select Case Cells(rTemp.Row, 4).Value
                            Case "Einkauf": Debug.Print "mach 1"
                            Case "Fracht": Debug.Print "mach 2"
                            Case "Kurier": Debug.Print "mach 3"
                            Case "Andere": Debug.Print "mach 4"
                       End Select
                End If
             
                booNot = False
        Next rTemp
   
   Next i
 End If

End Sub

Gruß Tino
Anzeige
AW: Nochmal angepasst
06.10.2009 20:18:27
Andre
Hallo Tino,
vielen Dank für Dein Bsp.
MFG Andre
Noch eine Frage dazu - Aktion nach Klick?
11.10.2009 14:20:32
Larissa
Hallo Excelprofis,
zu diesem Makro hätte ich noch mal eine Frage.
Wie müsste es heißen, wenn schon nach Anklicken der Zelle die entsprechenden Makros starten und nicht erst nach einer eingetragenen Änderung?
Vielen Dank schon mal für Eure Hilfe,
Gruß, Larissa
AW: Noch eine Frage dazu - Aktion nach Klick?
11.10.2009 15:23:10
Tino
Hallo,
versuche es mal mit dem Event- Makro
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Gruß Tino
Es funktioniert nur einmal
11.10.2009 15:57:29
Larissa
Danke Tino, das scheint zwar zu funktionieren, aber nur einmal.
Dann erst wieder, wenn ich die Mappe schließe und neu öffne.
Woran kann das nur liegen?
Gruß, Larissa
Anzeige
Application.EnableEvents ist auf False
11.10.2009 16:16:44
Tino
Hallo,
mit Sicherheit stellst Du die Eventbehandlung irgendwo ab und nicht wieder an.
Application.EnableEvents = False
muss auch wieder auf True gesetzt werden.
Verlässt Du irgendwo vielleicht ein Makro vorzeitig und stellst dies nicht wieder zurück auf True.
Gruß Tino
Stimmt - Danke Tino
11.10.2009 16:30:09
Larissa
Natürlich war das genau die Ursache.
Danke Tino.
Ich möchte noch eine MsgBox einfügen, aber wo?
11.10.2009 17:57:21
Larissa
Hallo,
ich möchte in dem Makro noch eine Abfrage einbauen, bevor die Makros starten, aber ich finde nicht die Stelle, wo die MsgBox positioniert werden muss.
Die MsgBox soll nur starten, wenn in der Zeile Daten vorhanden sind.
Sie soll nicht starten, wenn in Spalte 4 ein "/" eingetragen ist.
So sieht die MsgBox aus:
If MsgBox("Werden bereits erfasste Daten dieser Rechnung im Nachhinein geändert?", vbQuestion + vbYesNo, "Frage?") = vbNo Then
Exit Sub
End If
Danke für Eure Hilfe, lieben Gruß Larissa
Anzeige
verstehe jetzt eigentlich nicht
11.10.2009 18:36:52
Tino
Hallo,
was die MSG bringen soll, wenn diese sich auf die Spalte 4 bezieht.
Die Spalte wird doch schon von der Case- Abfrage überwacht
 Select Case Cells(rTemp.Row, 4).Value
Case "Einkauf": Debug.Print "mach 1"
Case "Fracht": Debug.Print "mach 2"
Case "Kurier": Debug.Print "mach 3"
Case "Andere": Debug.Print "mach 4"
End Select

Gruß Tino
AW: verstehe jetzt eigentlich nicht
11.10.2009 19:16:35
Larissa
Hallo Tino,
In Der Spalte 4 kann auch ein "/" stehen, oder eben eines der 4 Wörter "Einkauf", "Fracht" etc.
Bevor das Makro für "Einkauf", "Fracht" etc. losrennt, möchte ich die MsgBox setzen. Die soll aber nicht aufpoppen, wenn ein "/" in Spalte 4 steht.
Ich hoffe, das geht irgendwie.
Gruß,
Larissa
Anzeige
man muss nicht alles verstehen ;-)
11.10.2009 20:31:33
Tino
Hallo,
verstanden habe ich es immer noch nicht, :-(
wenn in Spalte 4 "/" steht kann ja nicht Einkauf oder Fracht drin stehen und somit
auch kein Makro aufgerufen werden.
Egal hier mal was zum testen,
habe die Msgbox in eine Funktion verfrachtet damit das Eventmakro schlanker bleibt.
Private Function MSG(rZelle As Range) As Long
If Not Cells(rZelle.Row, 4).Value = "/" Then
 If Application.WorksheetFunction.CountA(Cells(rZelle.Row, 4).EntireRow) > 0 Then
   MSG = MsgBox("Werden bereits erfasste Daten dieser Rechnung im Nachhinein geändert?", vbQuestion + vbYesNo, "Frage?")
 End If
End If
End Function

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Bereich As Range, rTemp As Range
Dim i As Integer, ii As Integer
Dim booNot As Boolean

With ActiveSheet.UsedRange
 Set Bereich = Intersect(Union(.Range("A:C"), .Range("E:J")), Target)
End With

 If Not Bereich Is Nothing Then
  For i = 1 To Bereich.Areas.Count
        
        For Each rTemp In Bereich.Areas(i).Columns(1).Cells
                
                If i > 1 Then
                  For ii = 1 To i - 1
                       booNot = (Not Intersect(Bereich.Areas(ii), rTemp.EntireRow) Is Nothing)
                       If booNot Then Exit For
                  Next ii
                End If
            
                If rTemp.Row > 1 And Not booNot Then  'ohne Überschrift Zeile 1 
                   If MSG(rTemp) = vbYes Then '<------------------- Funktion Msgbox 
                       Select Case Cells(rTemp.Row, 4).Value
                            Case "Einkauf": Debug.Print "mach 1"
                            Case "Fracht": Debug.Print "mach 2"
                            Case "Kurier": Debug.Print "mach 3"
                            Case "Andere": Debug.Print "mach 4"
                       End Select
                   End If
                End If
             
                booNot = False
        Next rTemp
   
   Next i
 End If

End Sub

Gruß Tino
Anzeige
ich habe eine Lösung gefunden ;-)
11.10.2009 21:14:44
Larissa
Hi Tino,
typisch, da habe ich mal wieder nicht deutlich genug erklärt, sorry.
Irgendwie bin ich jetzt auf eine Lösung gekommen, die funktioniert (auch wenn sie sehr nach "Larissa-Style" aussieht:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If cells(ActiveCell.Row, 4) = "/" Then
Exit Sub
End If
Dim Bereich As Range, rTemp As Range
Dim i As Integer, ii As Integer
Dim booNot As Boolean
With ActiveSheet.UsedRange
Set Bereich = Intersect(Union(.Range("A:C"), .Range("E:J")), Target)
End With
If IsEmpty(Bereich) Then
Exit Sub
Else
If MsgBox("Sollen bereits erfasste Daten dieser Rechnung geändert werden?", vbQuestion +  _
vbYesNo, "Frage?") = vbNo Then
Exit Sub
End If
End If
If Not Bereich Is Nothing Then
For i = 1 To Bereich.Areas.Count
For Each rTemp In Bereich.Areas(i).Columns(1).cells
If i > 1 Then
For ii = 1 To i - 1
booNot = (Not Intersect(Bereich.Areas(ii), rTemp.EntireRow) Is Nothing)
If booNot Then Exit For
Next ii
End If
If rTemp.Row > 1 And Not booNot Then  'ohne überschrift Zeile 1
Select Case cells(rTemp.Row, 4).Value
Case "Einkauf": Call Einkauf_back
Case "Fracht": Call Fracht_back
Case "Kurier": Call Kurier_back
Case "Andere": Call Andere_back
End Select
End If
booNot = False
Next rTemp
Next i
End If
End Sub
Deine neue Funktion ruft nicht die MsgBox auf, sondern springt gleich auf die Makros "Einkauf_back etc.
Vielen Dank trotzdem mal wieder für Deine super Unterstützung.
Gruß,
Larissa
Anzeige

301 Forumthreads zu ähnlichen Themen


Moin,
ich habe folgenden Code:
Sub Anzahl_Klassen() Dim anzKl As Integer anzKl = Worksheets("Tabelle1").Cells(1, 2).Value With Worksheets("Tabelle1") If anzKl = 0 Then .Rows("5:102").RowHeight = 0 Else: .Rows("5:" & anzKl * 11 + 3).RowHeight = 12.75 .Rows(anzKl * 11 + 5 & ":10...
Anzeige


Hallo Könner,
mal wieder an einem Punkt angekommen, wo ich echt nicht weiß, ob die PCs was Magisches können.
Das Makro unten ist prima gelaufen. Und dann mal wieder nicht. Jetzt gerade mal wieder nicht, daher mein Hilferuf. Als mir das das erste Mal passiert ist, habe ich den ganze...

Hallo,
innerhalb der Befehle unter:
Private Sub Worksheet_BeforerightClick(ByVal Target As Range, Cancel As Boolean)
wird
Private Sub Worksheet_Change(ByVal Target As Range)
aufgerufen. Ich möchte dies aber für den einen Durchlauf verhindern. Kann mir jemand weiterhelfen,...
Anzeige

Hallo Forum,
Worksheet_Change ist eine wunderbare Sache! (wenn sie funktioniert)
Also:
ich arbeite in einem Blatt mit: Private Sub Worksheet_Change(ByVal Target As Range)
funktioniert alles super. Nur manchmal tut das nicht!!!!
Excel beenden, neu starten, alles klar und funk...

Hallo zusammen,
möchte folgenden Code aus Private Sub Worksheet_Change(ByVal Target As Range) in ein Modul auslagern. Soll heissen: unabhä _ _ ngig von einer Eingabe wie dargestellt soll ein Makro hingehen und prüfen, ob aufgrund der _ Werte im genannten I-Bereich noch Änderungen / Ergän...

Hallo zusammen,
brauche noch einmal Eure Hilfe! Ich nutze folgenden Code.
Wie müsste ich den Code ändern, wenn die Änderungen nicht in dem aktiven Blatt sondern im Reiter mit dem Namen "Test" der gleichen Datei erfolgen müsste. Geht das übergreifend?
Vielen DAnk!
LG
Claudia<...

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige