Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Makro Startet nicht richtig





Frage

Hallo Excelprofis :-) Habe folgendes Modul Option Explicit Public Pause As Variant Dim arr1 As Variant Dim arr2 As Variant Sub Ende() On Error Resume Next Application.OnTime Pause, "Blinken", , False Pause = "" End Sub Sub Blinken() Pause = Now + TimeValue("00:00:01") If Range(arr1).Interior.ColorIndex = 3 Then Range(arr1).Interior.ColorIndex = xlNone Range(arr2).Interior.ColorIndex = 4 Else Range(arr1).Interior.ColorIndex = 3 Range(arr2).Interior.ColorIndex = xlNone End If Application.OnTime Pause, "Blinken" End Sub Sub Bedingungen() Dim Bereich, xZelle As Range arr1 = "" arr2 = "" Set Bereich = Range("AD4:AD25") On Error Resume Next Bereich.Interior.ColorIndex = 0 For Each xZelle In Bereich If xZelle < 0 Then If arr1 = "" Then arr1 = xZelle.Address Else arr1 = arr1 & "," & xZelle.Address End If End If If xZelle > 3 Then If arr2 = "" Th Wie verhindere ich ein Übergreifen auf andere Tabellen wo das Makro nicht Wirken soll?? Danke MFG Noldi

Antwort 1 von Beverly

Hi Noldi,

setzte alles in eine With ... End With Anweisung und beziehe dich dabei auf das betreffende Tabellenblatt

Sub Blinken()
Pause = Now + TimeValue("00:00:01")
With Worksheets("Tabelle1")
    If .Range(arr1).Interior.ColorIndex = 3 Then
    .Range(arr1).Interior.ColorIndex = xlNone
    .Range(arr2).Interior.ColorIndex = 4
    Else
    .Range(arr1).Interior.ColorIndex = 3
    .Range(arr2).Interior.ColorIndex = xlNone
    End If
End With
Application.OnTime Pause, "Blinken"
End Sub


Entsprechend auch für den anderen Codeteil.

Bis später,
Karin

Antwort 2 von Noldi

Hallo Karin
Vielen Dank für die schnelle Antwort.
Leider habe ich keine Ahnung wie es im zweiten Teil aussehen muß.
Hier der zweite Teil

Sub Bedingungen()
Dim Bereich, xZelle As Range
arr1 = ""
arr2 = ""
Set Bereich = Range("AD4:AD25") '<=== Hier kann der Bereich geändert werden
On Error Resume Next
Bereich.Interior.ColorIndex = 0
For Each xZelle In Bereich
If xZelle < 0 Then '<=== Bedingung 1 festlegen
If arr1 = "" Then
arr1 = xZelle.Address
Else
arr1 = arr1 & "," & xZelle.Address
End If
End If
If xZelle > 3 Then '<=== Bedingung 2 festlegen
If arr2 = "" Then
arr2 = xZelle.Address
Else
arr2 = arr2 & "," & xZelle.Address
End If
End If
Next xZelle
Ende
Blinken
End Sub

Wäre echt super wenn Ihr mir weiter helfen könnt
Mfg Noldi

Antwort 3 von Beverly

Hi Noldi,

versuche es so

Sub Bedingungen()
Dim Bereich, xZelle As Range
arr1 = ""
arr2 = ""
With Worksheets("Tabelle1")
    Set Bereich = .Range("AD4:AD25") '<=== Hier kann der Bereich geändert werden
    On Error Resume Next
    Bereich.Interior.ColorIndex = 0
    For Each xZelle In Bereich
        If xZelle < 0 Then '<=== Bedingung 1 festlegen
            If arr1 = "" Then
                arr1 = xZelle.Address
            Else
                arr1 = arr1 & "," & xZelle.Address
            End If
        End If
        If xZelle > 3 Then '<=== Bedingung 2 festlegen
            If arr2 = "" Then
                arr2 = xZelle.Address
            Else
                arr2 = arr2 & "," & xZelle.Address
            End If
        End If
    Next xZelle
    Ende
End With
    Blinken
End Sub


Bis später,
Karin

Antwort 4 von Noldi

Hallo Karin

Es Funktioniert leider nich :-(

Ich habe noch folgende Formel in dieser Arbeitsmappe stehen

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call Ende
End Sub

Private Sub Workbook_Deactivate()
Call Ende
End Sub
Private Sub Workbook_Open()
Call Bedingungen
End Sub

und in Tabelle2(St.2Hlb.)

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Call Bedingungen
End Sub
Ich verstehe es einfach nicht sitze nun schon Stunden und tüftle herrum.
Gruß Noldi

Antwort 5 von Beverly

Hi Noldi,

vielleicht wäre es einfacher, wenn du deine Arbeitsmappe mal hochlädst. Hier Link zum Upload kannst du das für 100 Tage kostenlos tun. Die Linkadresse, die du dort nach dem Hochladen erhältst, musst du in einen Beitrag hier im Forum kopieren.

Bis später,
Karin

Antwort 6 von Noldi

Hallo Karin
Habe festgestellt das ich einen schreibfehler in der Formel hatte.Jetzt Funktioniert es einwandfrei. Danke für Deine Hilfe.
Echt SUPER das Forum hier.

Gruß Noldi

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: