Live-Forum - Die aktuellen Beiträge
Datum
Titel
17.04.2024 18:57:33
17.04.2024 16:56:58
Anzeige
Archiv - Navigation
584to588
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
584to588
584to588
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Makro

Makro
14.03.2005 18:04:59
Doreen
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

		

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro
14.03.2005 18:15:00
Hajo_Zi
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.


Anzeige
AW: Makro
14.03.2005 18:22:15
Doreen
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
AW: Makro
14.03.2005 18:52:04
Hajo_Zi
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.
Anzeige
AW: Makro
14.03.2005 19:22:49
MichaV
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 


Gruß! Micha
PS: Rückmeldung wäre nett.
Anzeige
PS:
14.03.2005 19:31:29
MichaV
Hi Doreen,
ich hab bei Set isect = Application.Intersect(Target, [A1:A2000]) die Adresse geändert, müsstest Du wieder anpassen.
Gruß
AW: Makro
15.03.2005 09:52:57
Doreen
Hallo Micha,
SUPER ich Danke Dir hat geklappt.
lg
Doreen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige