Anzeige
Archiv - Navigation
1844to1848
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
Inhaltsverzeichnis

2 x gleiches VBA auf 2 verschiedenen Wks

2 x gleiches VBA auf 2 verschiedenen Wks
14.09.2021 13:03:13
Boory
Hallo Forum,
ich benötige 2 x das selbe VBA-Makro auf jeweils unterschiedlichen Worksheets der gleichen Datei. ziel ist es, in einer recht langen Datei (Jahresplanung) "weiter hinten" etwas ändern zu können und dabei den ganz links angezeigten Mitarbeiter (fixiert) zu markieren, damit man nicht in der Zeile verrutscht.
Ich habe das mit "Colorindex" umgesetzt. Da es sich um mehrere Tabellenblätter handelt, auf denen dieselbe Funktion greifen soll, müsste ich wohl das Script an jedes Tabellenblatt anpassen - nur wie...?
Hier der verwendete Code (Auf dem ersten Tabellenblatt funktioniert es tadellos ab Nr. 2 nicht mehr).

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Not Intersect(Target, Range("8:40")) Is Nothing Then
Rows("8:40").Interior.ColorIndex = 0
Range("E" & Target.Row & ":F" & Target.Row).Interior.ColorIndex = 8
End If
End Sub
Wie bringe ich das Ganze dazu, auf verschiedenen Tabellenblättern das gleiche zu tun? Per Modul geht nicht, da auf einem Tabellenblatt die einzufärbenden Zellen an jeweils anderen Positionen sitzen. Also müsste ich schon den Code definiert für den jeweiligen Namen des Tabellenblattes anpassen - weiß nur nicht, wie
Schon mal ganz lieben Dank für Eure Unterstützung!
Boory

15
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Code in DieseArbeitsmappe
14.09.2021 13:18:45
Matthias
Hallo,

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Range("8:40")) Is Nothing Then
Rows("8:40").Interior.ColorIndex = 0
Range("E" & Target.Row & ":F" & Target.Row).Interior.ColorIndex = 8
End If
End Sub
Gruß Matthias
AW: Code in DieseArbeitsmappe
14.09.2021 13:26:31
Boory
Hallo Matthias,
hmmmm... Habs jetzt von "Worksheet_SelectionChange" in "Workbook_SheetSelectionChange" geändert. Allerdings geht jetzt gar nichts mehr.
Eine andere Änderung habe ich jetzt nicht entdecken können. Kann es sein, dass ich die Namen der Tabellenblätter angeben muss, auf denen der
jeweilige Code ausgeführt werden soll?
Gruß Boory
Anzeige
AW: Code in DieseArbeitsmappe
14.09.2021 13:31:30
Matthias
Der Code geört in

DieseArbeitsmappe
Stand doch im Betreff.
AW: Code in DieseArbeitsmappe
14.09.2021 13:39:32
Boory
Hallo Matthias,
Ich brauche diese Farbmarkierung auf mehreren Tabellenblättern, die zT. UNTERSCHIEDLICH ausgelegt sind. Das heißt, dass die Namen, die farblich markiert werden müssen, nicht immer in der Range "E" bis "F" stehen (insgesamt drei Tabellenblätter). Daher brauche ich wohl eine Lösung, in der ich entweder in jedem Tabellenblatt einen eigenen Code habe oder mal prinzipiell die Tabellenblätter mit Namen "anspreche". Ich habe nur keine Idee, wie ich das anstellen muss...
Gruß Boory
Anzeige
AW: Code in DieseArbeitsmappe
14.09.2021 13:42:30
Peter
Hmmpf...
Ich glaube, du musst dir erst mal selber klar darüber werden, was genau gemeinsam zwischen den Blättern ist / gemacht werden soll... Dann findet man auch einen Algorithmus dazu!
AW: Code in DieseArbeitsmappe
14.09.2021 13:39:43
Peter
Der Code von Matthias muss jetzt in "Diese Arbeitsmappe" anstatt im Code des Tabellenblattes stehen!
Übergibt als erstes auch das Sheet, von dem es ausgelöst wurde, Kannst du mit "Sh.Name" ggf. mit Namen von Sheets vergleichen, auf denen das Makro NICHT ausgeführt werden soll.
Kommentare:
- "Rows("8:40").Interior.ColorIndex = 0" erzeugt Hintergrundfarbe weiß! gewollt?
"Rows("8:40").Interior.ColorIndex = xlNone" dagegen löscht die aktuelle Farbe (so wie das auch bei einer frischen Mappe ist)
- "Range("E" & Target.Row & ":F" & Target.Row).Interior.ColorIndex = 8" ist fürchterlich! Viel besser:
"Range(Cells(Target.Row, 5), Cells(Target.Row, 6)).Interior.ColorIndex = 8"
Anzeige
AW: Code in DieseArbeitsmappe
14.09.2021 13:49:28
Boory
Hallo Peter,
Genau diese Namensübergabe des auslösenden Tabellenblatts fehlt mir ja. :'(
An welcher Stelle müßte ich das denn einbauen? Könntest Du mir da einen Code-Schnipsel schicken?

- "Rows("8:40").Interior.ColorIndex = 0" erzeugt Hintergrundfarbe weiß! gewollt?
- hatte ich so gesetzt, um die vorherige Farbmarkierung zu eliminieren. Aber Deine Version gefällt mir, glaube ich, besser... :)

- "Range("E" & Target.Row & ":F" & Target.Row).Interior.ColorIndex = 8" ist fürchterlich!
...und ich war so stolz darauf. Aber ich denke, auch da werde ich Deinen Vorsachlag annehmen. Schaut "eleganter" aus.
Wenn Du mir jetzt noch sagen kannst, wie ich die Tabellenblatt-Definition einbauen muss...?
Vielen Dank und Gruß
Boory
Anzeige
AW: Code in DieseArbeitsmappe
14.09.2021 14:39:25
Peter
- ""Range("E" & Target.Row & ":F" & Target.Row).Interior.ColorIndex = 8" ist fürchterlich!":
Damit meine ich, dass man Zellranges mit Buchstaben zusammenbaut. Stringberechnungen sind unendlich viel langsamer als mit Zahlen zu rechnen! Bei nur einer Zeile damit sicher kein Problem, aber wenn man es sich gleich richtig angewöhnt... Außerdem kann man Spalten (als Zahlen) viel leichter errechnen als Buchstaben.
Hier ja deine Sub in "DieseArbeitsmappe":

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not Intersect(Target, Range("8:40")) Is Nothing Then
Rows("8:40").Interior.ColorIndex = 0
Range("E" & Target.Row & ":F" & Target.Row).Interior.ColorIndex = 8
End If
End Sub
- Was genau soll in Zeile 2 "Range("8:40")" eigentlich sein? du meintest bestimmt "Rows("8:40")", oder?
Deshalb vielleicht auch die Fehlermeldung?
Also Vorschlag 1 (ganz ohne Stringadressen):

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim Zielbereich As Range
Select Case Sh.Name
Case "GutName1", "GutName2" 'usw.
'Nur auf diesen Seiten ausführen:
Set Zielbereich = Range(Cells(8, 1), Cells(40, 1)).Entirerow
If Not Intersect(Target, Zielbereich) Is Nothing Then
Zielbereich.Interior.ColorIndex = xlNone
Range(Cells(Target.Row, 5), Cells(Target.Row, 6)).Interior.ColorIndex = 8
End If
End Select
End Sub
oder, wenn viele GutNamen sind und nur wenige, wo nicht behandelt werden sollen:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim Zielbereich As Range
Select Case Sh.Name
Case "SchlechtName1", "SchlechtName2" 'usw.
Case Else
'Nur auf diesen Seiten ausführen:
Set Zielbereich = Range(Cells(8, 1), Cells(40, 1)).Entirerow
If Not Intersect(Target, Zielbereich) Is Nothing Then
Zielbereich.Interior.ColorIndex = xlNone
Range(Cells(Target.Row, 5), Cells(Target.Row, 6)).Interior.ColorIndex = 8
End If
End Select
End Sub


Anzeige
AW: Code in DieseArbeitsmappe
14.09.2021 15:19:23
Boory
Hallo Peter,
Dein Vorschlag 1 ist das, was so ziemlich genau das macht, was ich brauche! SUPER! Nur einen kleinen Makel hat das Ganze noch. Ich habe links von den zu markierenden Zellen (bei mir Cells(8, 5), Cells(40, 6) leider eine Legende mit Farbcodes stehen. Der Befehl "ColorIndex = xINone" löscht mir die Farbe der ganzen Zeile nach Links auch mit. Habe ich da eine Zuweisung übersehen? Eigentlich ist der Zielbereich, der gelöscht werden sollte, doch die 5. und 6. Spalte - oder habe ich das aus Deinem Code falsch herausgelesen?
AW: Code in DieseArbeitsmappe
14.09.2021 16:11:09
Peter
Mein Code löscht wie dein Code ("Rows("8:40").Interior.ColorIndex = 0") die Hintergrundfarbe der ganzen Zeilen 8 bis 40!?
Also wenn du nur in Spalten E und F die Hintergrundfarbe löschen willst...
... würde ich das ganz anders umsetzen:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Const rowA As Long = 8
Const rowE As Long = 40
Const colA As Long = 5 'Spalte E
Const colE As Long = 6 'F
Dim rowTarget As Long
Select Case Sh.Name
Case "Tabelle1", "Tabelle2" 'usw.
'Nur auf diesen Seiten ausführen:
rowTarget = Target.Row
Select Case rowTarget
Case rowA To rowE
'Nur in diesen Zeilen ausführen:
Range(Cells(rowA, colA), Cells(rowE, colE)).Interior.ColorIndex = xlNone
Range(Cells(rowTarget, colA), Cells(rowTarget, colE)).Interior.ColorIndex = 8
End Select
End Select
End Sub

Anzeige
AW: Code in DieseArbeitsmappe
14.09.2021 14:04:41
Boory
Um noch etwas zu ergänzen:
Auf dem ERSTEN Tabellenblatt funktioniert das Ganze. Sobald ich auf das ZWEITE Tabellenblatt wechsle und dort irgendwo in die beabsichtigten Bereiche klicke, springt der Debugger an und bringt mir Fehlermeldung "1004". Dabei wird mir die Zeile

Rows("8:40")...
gelb markiert (egal, ob mit "ColorIndex = 0" oder mit "xlNone".
What's wrong?
Boory
AW: 2 x gleiches VBA auf 2 verschiedenen Wks
14.09.2021 16:07:22
Daniel
HI
ich würde hier so vorgehen:
1. schreibe im Makro die Zeilennummer der aktiven Zelle in eine bestimmte freie Zelle (z.B. A1, kann aber jede andere sein.
2. mach die Umfärbung der Zellen dann per bedingter Formatierung, das hat den Vorteil, dass du diese Färbung nicht wieder löschen musst und eine eventuell vorhandene "normale" Färbung der Zellen erhalten bleibt und wieder angewendet wird, wenn eine andere Zeile aktiv ist .
dh als Regel für die Bedingte Formatierung für die Zellen der Spalte E und F nimm: =Zeile()=$A$1
und als Code im Change-Eventmakro reicht dann:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Range("A1").Value = Target.Row
End Sub
Gruß Daniel
Anzeige
AW: 2 x gleiches VBA auf 2 verschiedenen Wks
15.09.2021 06:36:16
Boory
Hallo Daniel,
Danke für den Vorschlag - werde ich ausprobieren! :)
Gruß´- Boory
AW: 2 x gleiches VBA auf 2 verschiedenen Wks
15.09.2021 10:16:01
Boory
@all:
Vielen Dank für Eure Unterstützung. Ich konnte mein Problem inzwischen erledigen. Vorrangig habe ich mich auf den "Vorschlag 1" von Peter gestützt, mit dessen Tip ich die meisten Punkte "erschlagen" konnte. Daher speziell Dir nochmal herzlichen Dank!
Trotzdem auch vielen Dank an Matthias und Daniel, die mich mit ihren Beiträgen gedanklich in die richtige Richtung geschubst haben!
Und wieder mal - das Herber.de - Forum ist das Beste! :)
Viele Grüße - Boory
ERLEDIGT! 2 x gleiches VBA auf 2 verschiedenen Wks
15.09.2021 10:18:25
Boory
Ups - vergessen - Thema ist somit erledigt!
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige