Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1536to1540
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

VBA Zellen im Bereich formatieren

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

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

Betreff
Datum
Anwender
Anzeige
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
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
Anzeige
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

Anzeige
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

Anzeige
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

314 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige