Makro starten, wenn zelleninhalt sich verändert

[KS20]

Hallo liebe Gemeinde;

folgendes Problem habe mir ein Makro gebaut,

es wird automatisch nach der Größe sortiere, wenn eine bestimmte Zelle verändert wird.

Funktioniert super, wenn ich die Zelle per Hand ändere, wenn ich einen verweis auf eine andere Zelle lege, also die Zelle M1 sich die Daten holt, funktioniert es nicht!

Hat wer eine Idee?


Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Cells.Count > 1 Then Exit Sub
   If Intersect(Target, Range("$M$1")) Is Nothing Then Exit Sub
    ActiveWorkbook.Worksheets("Nebenrechnungen").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Nebenrechnungen").AutoFilter.Sort.SortFields.Add _
        Key:=Range("K3"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Nebenrechnungen").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
End Sub

[Rabe]

Hi,

Funktioniert super, wenn ich die Zelle per Hand ändere, wenn ich einen verweis auf eine andere Zelle lege, also die Zelle M1 sich die Daten holt, funktioniert es nicht!

das geht meines Wissens nicht, da eine Änderung per Formel nicht als Change-Event erkannt wird.

[KS20]

Gibt es denn da eine andere Lösung?

bzw. weiß wer eine?

Danke

[RPP63]

Moin!
Dann musst Du halt die Zelle(n) überwachen, die das Formelergebnis in M1 verändern.

Gruß Ralf

[Käpt'n Blaubär]

Hallo,

Gibt es denn da eine andere Lösung?

bzw. weiß wer eine?

(ungetestet)
Ich schlage vor, daß Du Dir eine Zelle einrichtest, in die Du den Formelwert aus, ich glaube M1 war es, übertragen läßt.
Dann sollte das mit dem Auslesen der Wertänderung klappen.

[KS20]

Hallo,

hat alles nicht funktioniert, dann Plan B

so sieht nun mein Makro aus:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Cells.Count > 1 Then Exit Sub
 [color=#333333]  If Intersect(Target, Range("$M$1")) Is Nothing Then Exit Sub[/color]
    ActiveWorkbook.Worksheets("Nebenrechnungen").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Nebenrechnungen").AutoFilter.Sort.SortFields.Add _
        Key:=Range("K3"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Nebenrechnungen").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   End Sub

Die Sortierung wird im Tabellenblatt "Nebenrechnungen" gestartet
Was muss ich ändern, dass er startet, wenn ich im Tabellenblatt "TEST" im Bereich A9:A30 was ändere?
Dann müsste ich doch die Zeile:

 If Intersect(Target, Range("$M$1")) Is Nothing Then Exit Sub

anpassen? Aber da hänge ich nun fest!

Danke

[schauan]

Hallöchen,

ich hoffe, das Makro hast Du schon im Modul des Tabellenblattes Test. Dann brauchst Du nur statt "M1" "A9:A30" einzusetzen.

[RPP63]

Noch eine Ergänzung:
Arbeite niemals mit ActiveWorbook, wenn es sich verhindern lässt.
Hier also ThisWorkbook

(in diesem speziellen Fall ist es unerheblich, es dient mir auch nur der Sensibilisierung zur Verhinderung von unexpected errors)

Gruß Ralf

[chris-ka]

Hi,

If Target.Cells.Count > 1 Then Exit Sub

mache eine Kopie der Mappe ->
markiere mal das ganze Blatt und drücke die Entf. Taste;)

[KS20]

Hi,

danke für die vielen Tipps, jetzt noch ein kleines Problem^^

Wie bekomme ich Makros zusammen nun aktiv in das Tabellenblatt, wenn da schon ein Makro steht?

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
On Error Resume Next
Set rng = Range("ad9:as999")
If Not Intersect(rng, Target) Is Nothing Then
    Application.EnableEvents = False
    Target(1, 1).Value = WorksheetFunction.VLookup(Target(1, 1).Value, Tabelle3.Range("a2:b33"), 2, 0)
  
End If
errmsg:
On Error GoTo 0
Application.EnableEvents = True
   If Intersect(Target, Range("A1:A100")) Is Nothing Then Exit Sub
   If Target.Value <> "" Then
      Target.Offset(0, 1).Value = Date
   Else
      Target.Offset(0, 1).ClearContents
   End If
End Sub

Das habe ich dort schon

und das soll mit rein:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.Cells.Count > 1 Then Exit Sub
   If Intersect(Target, Range("$M$1")) Is Nothing Then Exit Sub
    ActiveWorkbook.Worksheets("Nebenrechnungen").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Nebenrechnungen").AutoFilter.Sort.SortFields.Add _
        Key:=Range("K3"), SortOn:=xlSortOnValues, Order:=xlDescending, _
        DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Nebenrechnungen").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    MsgBox "Makro gestartet!"
End Sub

Danke