VBA Zellen im Bereich formatieren

Forumthread: VBA Zellen im Bereich formatieren

30.01.2017 15:41:56

Blue

Servus liebe Forumgemeinde,
ich suche schon seid längerem eine VBA Lösung zur folgenden Situation, hoffentlich kann mir jemand weiter helfen.
In einer Datei habe ich mehrere gleiche Tabellen, in denen ich in jeder Tabelle einen anderen Eintrag (X) setze.
Nun soll die Zelle mit dem Eintrag und der passende Tabellenkopf und Tabellenseite (linke Seite) farbig ausgefüllt werden.
Folgendes müsste das Makro aus meiner Sicht machen:
1. finde den Eintrag (X)
2. suche max. 5 Zellen weiter oben nach den Texten "LPH4" oder "LPH5", wenn gefunden farbig ausfüllen
3. suche max. 4 Zellen weiter oben nach den Texten "Prüfung" oder "Freigabe", wenn gefunden farbig ausfüllen
4. suche max. 4 Zellen weiter links nach den Texten "Bewehrungspläne", "Fertigteil- & Einbauteilpläne", "Positionspläne", "Schalpläne" oder "Stahlbau Übersichtspläne", wenn gefunden farbig ausfüllen
Die farbe die zum ausfüllen genommen werden soll, soll natürlich immer die gleiche sein.
Hier noch eine Datei mit Beispielen wie es zum Schluss aussehen soll:
https://www.herber.de/bbs/user/111006.xlsm
mfg Blue Bird

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Datei kennwortgeschützt

30.01.2017 17:22:00

Michael

Hi,
ich würde in den zu färbenden Zellen eine bedingte Formatierung mit Formel vornehmen.
Was ist eigentlich, wenn ein weiteres x gesetzt wird?
Gruß,
Michael

AW: Datei kennwortgeschützt

30.01.2017 19:35:28

Luschi

Hi
hier die Datei ohne Vba-KW
https://www.herber.de/bbs/user/111016.xlsm
Gruß von Luschi
aus klein-Paris

VBA Zellen im Bereich formatieren

31.01.2017 06:27:56

Blue

Servus,
hier nochmal die Datei ohne Passwörter und mit mehr Einträgen damit das ganze noch etwas verständlicher ist.
https://www.herber.de/bbs/user/111021.xlsm
@Michael, die Sache mit Bedingter Formatierung hatte ich auch schon überlegt, aber bin auf keine Lösung gekommen.
Des weiteren wären das glaube dann sehr viele Formatierungen und mit einem Makro wäre man Fertig.
Und hätte für ähnliche Situation einen geringeren Änderungsaufwand.
PS. es kommt immer nur ein X pro Tabelle.
mfg Blue Bird

AW: VBA Zellen im Bereich formatieren

01.02.2017 00:29:08

Piet

Hallo Blue Bird
anbei ein in deinem Beispiel getesteter Makro Code der die Aufgabe lösen sollte. Einfach in ein neues Modul kopieren und testen. Damit du den zu prüfenden Text leichter aendern kannst sind 5 Texte als Const festgelgt. Kleine Besonderheit sind die QTexte 4+5. Da gibt es in Originaltext einen Seitenumbruch. Ich habe sie als QText deklariert, weil ich die Texte als Teil-Strings prüfen muss.
mfg Piet


Option Explicit      '31.1.2017   Piet  Herber Forum
'1. finde den Eintrag (X)
'2. suche max. 5 Zellen weiter oben nach den Texten "LPH4" oder "LPH5", wenn gefunden farbig  _
ausfüllen
'3. suche max. 4 Zellen weiter oben nach den Texten "Prüfung" oder "Freigabe", wenn gefunden  _
farbig ausfüllen
'4. suche max. 4 Zellen weiter links nach den Texten "Bewehrungspläne", "Fertigteil- &  _
Einbauteilpläne", "Positionspläne", "Schalpläne" oder "Stahlbau Übersichtspläne", wenn gefunden farbig ausfüllen
Const Txt1 = "Bewehrungspläne"
Const Txt2 = "Positionspläne"    '
Const Txt3 = "Schalpläne"
Const QTxt4 = "Fertigteil- & Einbauteilpläne"
Const QTxt5 = "Stahlbau Übersichtspläne"
Const Farbe = 10
Sub Farblich_markieren()
Dim AC As Object, j, Txt As String
Dim QTxt As String, LTxt As String
Sheets("Tabelle1").Select
'alte Innenfarbe löschen
ActiveSheet.UsedRange.Interior.ColorIndex = xlNone
'Schleife für UsedRange nach "X" durchsuchen
For Each AC In ActiveSheet.UsedRange
If AC.Value = "X" Then
AC.Interior.ColorIndex = Farbe
'suche nach oben nach Text oder "LPHxx"
For j = 1 To 20
If AC.Offset(-j, 0).RowHeight  Empty Or LTxt  Empty Then
'suche ganzes Wort "Prüfung" oder "Freigabe"
If Txt = "Prüfung" Or Txt = "Freigabe" Then
AC.Offset(-j, 0).Interior.ColorIndex = Farbe
End If
'suche Text "LPHxx" in String
If InStr(Txt, "LPH 4") Or InStr(Txt, "LPH 5") Or _
InStr(Txt, "LPH4") Or InStr(Txt, "LPH5") Then
AC.Offset(-j, 0).Interior.ColorIndex = Farbe
End If
'suche L-Text "LPHxx" in Left String  (Verundzelle)
If InStr(LTxt, "LPH 4") Or InStr(LTxt, "LPH 5") Or _
InStr(LTxt, "LPH4") Or InStr(LTxt, "LPH5") Then
AC.Offset(-j, -1).Interior.ColorIndex = Farbe
End If
End If
Next j
'suche nach links mehrere Texte (Pläne)
For j = 1 To 4
If AC.Offset(0, -j).ColumnWidth  Empty Then
If Txt = Txt1 Or Txt = Txt2 Or Txt = Txt3 Then
AC.Offset(0, -j).Interior.ColorIndex = Farbe
Else
'Pläne mit Space und LF im Text
If Left(Txt, 8) = Left(QTxt4, 8) And _
Right(Txt, 12) = Right(QTxt4, 12) Then
AC.Offset(0, -j).Interior.ColorIndex = Farbe
End If
If Left(Txt, 8) = Left(QTxt5, 8) And _
Right(Txt, 12) = Right(QTxt5, 12) Then
AC.Offset(0, -j).Interior.ColorIndex = Farbe
End If
End If
End If
If AC.Offset(0, -j).Column = 2 Then Exit For
Next j
End If
Next AC
End Sub

AW: VBA Zellen im Bereich formatieren

01.02.2017 07:46:05

Blue

Servus Piet,
danke dir vielmals für das Makro.
Das ist genau das was ich gesucht habe.
Wenn ich mich dann genauer hinein gedacht habe, sollte mir das zukünftig auch bei vielen ähnlichen Situationen helfen.
Eine Frage hätte ich allerdings noch.
Wie bekomme ich es hin das das Makro sich von allein ausführt sobald der Eintrag (X) gesetzt wird.
Das wäre noch das i Tüpfelchen bei der ganzen Sache.
mfg Blue Bird

AW: VBA Zellen im Bereich formatieren

01.02.2017 11:40:56

Piet

Hallo BlueBird,
das ist sehr einfach, den Code kann man sogar verkürzen. Dann muss er aber ins Tabellenblatt kopiert werden,
Nİcht in ein Modulblatt!! Korrigiere bitte noch einen kleinen Fehler im alten Code, und zwar hier:
For j = 1 To 20 - statt 20 bitte 6 oder 7 einfügen
mfg Piet


'direkt ins Tabellenblatt kopieren  (kein Modulblatt!!)
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Value = "x" Or Target.Value = "X" Then
Target.Interior.ColorIndex = Farbe
'suche nach oben nach Text oder "LPHxx"
For j = 1 To 7
If Target.Offset(-j, 0).RowHeight  Empty Or LTxt  Empty Then
'suche ganzes Wort "Prüfung" oder "Freigabe"
If Txt = "Prüfung" Or Txt = "Freigabe" Then
Target.Offset(-j, 0).Interior.ColorIndex = Farbe
End If
'suche Text "LPHxx" in String
If InStr(Txt, "LPH 4") Or InStr(Txt, "LPH 5") Or _
InStr(Txt, "LPH4") Or InStr(Txt, "LPH5") Then
Target.Offset(-j, 0).Interior.ColorIndex = Farbe
End If
'suche L-Text "LPHxx" in Left String  (Verundzelle)
If InStr(LTxt, "LPH 4") Or InStr(LTxt, "LPH 5") Or _
InStr(LTxt, "LPH4") Or InStr(LTxt, "LPH5") Then
Target.Offset(-j, -1).Interior.ColorIndex = Farbe
End If
End If
Next j
'suche nach links mehrere Texte (Pläne)
For j = 1 To 4
If Target.Offset(0, -j).ColumnWidth  Empty Then
If Txt = Txt1 Or Txt = Txt2 Or Txt = Txt3 Then
Target.Offset(0, -j).Interior.ColorIndex = Farbe
Else
'Pläne mit Space und LF im Text
If Left(Txt, 8) = Left(QTxt4, 8) And _
Right(Txt, 12) = Right(QTxt4, 12) Then
Target.Offset(0, -j).Interior.ColorIndex = Farbe
End If
If Left(Txt, 8) = Left(QTxt5, 8) And _
Right(Txt, 12) = Right(QTxt5, 12) Then
Target.Offset(0, -j).Interior.ColorIndex = Farbe
End If
End If
End If
If Target.Offset(0, -j).Column = 2 Then Exit For
Next j
End If
End Sub

AW: VBA Zellen im Bereich formatieren

01.02.2017 11:48:39

Piet

Nachtrag
ich habe etwas vergessen, musst du unbedingt machen. Im Modulblatt müssen alle Const Anweisungen in Public Const als Öffentliche Konstante geaendert werden, damit das Tabellenblatt auch auf die Texte zugreifen kann. Sonst klappt es nicht !!
mfg Piet

Beliebteste Forumthreads (12 Monate)

VBA Zellen im Bereich formatieren

Forumthread: VBA Zellen im Bereich formatieren

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

VBA Zellen im Bereich formatieren

Forumthread: VBA Zellen im Bereich formatieren

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread