Makro

  • Makro von Doreen vom 14.03.2005 18:04:59
Bild

Betrifft: Makro
von: Doreen
Geschrieben am: 14.03.2005 18:04:59
Hallo Ihr Lieben,
habe folgendes Makro:


Private Sub Worksheet_Change(ByVal Target As Range)
Set isect = Application.Intersect(Target, [R1:R2000])
If Not isect Is Nothing Then
    On Error GoTo ende
    Select Case Target.Value
        Case Is = "0"
        Range(Cells(Target.Row, 1), Cells(Target.Row, 35)).Interior.ColorIndex = 24
        Case Is = 90
        Range(Cells(Target.Row, 1), Cells(Target.Row, 35)).Interior.ColorIndex = 36
        Case Is = 100, 99
        Range(Cells(Target.Row, 1), Cells(Target.Row, 35)).Interior.ColorIndex = 35
        Case Else
        Range(Cells(Target.Row, 1), Cells(Target.Row, 35)).Interior.ColorIndex = 0 'oder xlnone
    End Select
End If
'bei Wert 100 = Hintergrundfarbe grün
'bei Wert 90 = Hintergrundfarbe gelb
'bei Wert 0 = Hintergrundfarbe grau
'bei allen anderen = ohne Hintergrundfarbe
ende:
Application.EnableEvents = False
Cells(Target.Row, 37) = Environ("USERNAME")
'37 = Spalte "AK" bei diesem Makro wird der letzte Änderer gekennzeichnet
Application.EnableEvents = True
End Sub

Option Explicit
Public Changeflag As Boolean

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim DB As Object
On Error GoTo Ende
Application.EnableEvents = False
If Changeflag Then Exit Sub
Changeflag = True
If Target.Row = ActiveSheet.Range("such").Row + 1 Then
    Set DB = ActiveSheet.Range("Datenbereich").CurrentRegion
    DB.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("such").CurrentRegion, Unique:=False
        Target.Select
    ActiveWindow.ScrollRow = DB.Row
End If
Ende:
Changeflag = False
Application.EnableEvents = True
End Sub


Nun schreibt er mit Typenunverträglich, da ich zweimal

Private Sub Worksheet_Change   habe 
Ausßerdem kommt er mit dem Befehl   Set isect  nicht mehr klar
Kann mir jemand helfen?
lg
Doreen
Bild

Betrifft: AW: Makro
von: Hajo_Zi
Geschrieben am: 14.03.2005 18:15:00
Hallo Dorren,
ich habe es jetzt mal versucht Live umzuschreiben, vielkleicht klappt es.
Ich wollte jetzt nicht nachschauen was der Code alles macht.
Option Explicit
Public Changeflag As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim isect
    Dim DB As Object
    On Error GoTo Ende2
    Application.EnableEvents = False
    If Changeflag Then Exit Sub
    Changeflag = True
    If Target.Row = ActiveSheet.Range("such").Row + 1 Then
        Set DB = ActiveSheet.Range("Datenbereich").CurrentRegion
        DB.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
            Range("such").CurrentRegion, Unique:=False
            Target.Select
        ActiveWindow.ScrollRow = DB.Row
    End If
    On Error GoTo 0
    Set isect = Application.Intersect(Target, [R1:R2000])
    If Not isect Is Nothing Then
        On Error GoTo Ende
        Select Case Target.Value
            Case Is = "0"
            Range(Cells(Target.Row, 1), Cells(Target.Row, 35)).Interior.ColorIndex = 24
            Case Is = 90
            Range(Cells(Target.Row, 1), Cells(Target.Row, 35)).Interior.ColorIndex = 36
            Case Is = 100, 99
            Range(Cells(Target.Row, 1), Cells(Target.Row, 35)).Interior.ColorIndex = 35
            Case Else
            Range(Cells(Target.Row, 1), Cells(Target.Row, 35)).Interior.ColorIndex = 0 'oder xlnone
        End Select
    End If
    'bei Wert 100 = Hintergrundfarbe grün
    'bei Wert 90 = Hintergrundfarbe gelb
    'bei Wert 0 = Hintergrundfarbe grau
    'bei allen anderen = ohne Hintergrundfarbe
Ende:
    Application.EnableEvents = False
    Cells(Target.Row, 37) = Environ("USERNAME")
    '37 = Spalte "AK" bei diesem Makro wird der letzte Änderer gekennzeichnet
    Application.EnableEvents = True
    Exit Sub
Ende2:
    Changeflag = False
    Application.EnableEvents = True
End Sub

Bitte keine Mail, Probleme sollten im Forum gelöst werden.
Microsoft MVP für Excel
Das Forum lebt auch von den Rückmeldungen.
Betriebssystem XP Home SP2 und Excel Version 2003 SP1.


Bild

Betrifft: AW: Makro
von: Doreen
Geschrieben am: 14.03.2005 18:22:15
Hallo Hajo,
klappt leider nicht.
Beim ersten Teil soll er wenn ich einer betsimmten Zeile z.B. 100 steht die rot färben und den Änderer der Zelle namentlich hinschreiben.
Der zweite Teil besteht aus einem Autofilter.
Wenn ich Deine Änderung so nehme setz er den Autofilter nicht mehr zurück und die Zeile färbt sich nicht mehr.
Hast Du noch ne Idee?
lg
Doreen
Bild

Betrifft: AW: Makro
von: Hajo_Zi
Geschrieben am: 14.03.2005 18:52:04
Hallo Doreen,
ich habe versucht das Makro bei ir zum laufen zu bringen, es ist mir aber zu aufwendig Deine Datei nachzubauen.
Gruß Hajo
Das Forum lebt auch von den Rückmeldungen.
Bild

Betrifft: AW: Makro
von: MichaV
Geschrieben am: 14.03.2005 19:22:49
Hi Doreen,
ich habs auch mal versucht. Beide Makro- Teile laufen wie vorher, ich hab den Code nicht groß geändert, daher vielleicht noch Optimierungsfähig. Was allerdings der untere Teil genau soll, kann ich nicht nachvollziehen. Jedenfalls wird ein vorhandener Autofilter zurück gesetzt, das war ja auch Dein Ziel.


      
Option Explicit
Public Changeflag As Boolean
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim DB As Object
Dim isect
Set isect = Application.Intersect(Target,[A1:A2000])
If Not isect Is Nothing Then
    
On Error GoTo ende
    
Select Case Target.Value
        
Case Is = "0"
        Range(Cells(Target.Row, 1), Cells(Target.Row, 35)).Interior.ColorIndex = 24
        
Case Is = 90
        Range(Cells(Target.Row, 1), Cells(Target.Row, 35)).Interior.ColorIndex = 36
        
Case Is = 100, 99
        Range(Cells(Target.Row, 1), Cells(Target.Row, 35)).Interior.ColorIndex = 35
        
Case Else
        Range(Cells(Target.Row, 1), Cells(Target.Row, 35)).Interior.ColorIndex = 0 
'oder xlnone
    End Select
End If
'bei Wert 100 = Hintergrundfarbe grün
'bei Wert 90 = Hintergrundfarbe gelb
'bei Wert 0 = Hintergrundfarbe grau
'bei allen anderen = ohne Hintergrundfarbe
ende:
Application.EnableEvents = 
False
Cells(Target.Row, 37) = Environ("USERNAME")
'37 = Spalte "AK" bei diesem Makro wird der letzte Änderer gekennzeichnet
'Application.EnableEvents = True (gleich wieder false)

On Error GoTo ende1
'Application.EnableEvents = False (hatten wir oben schon mal
If Changeflag Then Exit Sub
Changeflag = 
True
If Target.Row = ActiveSheet.Range("such").Row + 1 Then
    
Set DB = ActiveSheet.Range("Datenbereich").CurrentRegion
    DB.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Range("such").CurrentRegion, Unique:=
False
        Target.Select
    ActiveWindow.ScrollRow = DB.Row
End If
ende1:
Changeflag = 
False
Application.EnableEvents = 
True
End Sub 

     Code eingefügt mit Syntaxhighlighter 3.0

Gruß! Micha
PS: Rückmeldung wäre nett.
Bild

Betrifft: PS:
von: MichaV
Geschrieben am: 14.03.2005 19:31:29
Hi Doreen,
ich hab bei Set isect = Application.Intersect(Target, [A1:A2000]) die Adresse geändert, müsstest Du wieder anpassen.
Gruß
Bild

Betrifft: AW: Makro
von: Doreen
Geschrieben am: 15.03.2005 09:52:57
Hallo Micha,
SUPER ich Danke Dir hat geklappt.
lg
Doreen
 Bild

Beiträge aus den Excel-Beispielen zum Thema "Bereich einrahmen"