Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 15:03:35
Unterschiedliche Dateien miteinander abgleichen lassen
25.04.2024 14:05:48
Makro in aktueller Zelle ausführen mit Doppelklick
25.04.2024 12:56:25
Werte von Kunden und Artikel stehen untereinander
25.04.2024 12:55:42
Funktionsparameter auslesen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
704to708
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
704to708
704to708
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

VBA Formula bed. Format

VBA Formula bed. Format
05.12.2005 09:55:26
Horst
Guten Morgen,
wer wäre mir bitte behilflich: Habe in Spalte 6 und im Bereich Spalte 15 bis 76 (dynamisch)Kriterien für bed. Formatierung. In Spalte 6 (3 Kriterien) immer, im Bereich 17-76 in jeder 2. Spalte evtl. eine Eingabe "X". Beide müssen zutreffen.
Bekomme die Zeilen der Bedingungen nicht hin. Habe mit Formula und Local versucht. Was ist verkehrt? Wer könnte mir das bitte korrigieren?
' Bereich = definierter Name =BEREICH.VERSCHIEBEN('1'!$B$2;;;ANZAHL2('1'!$B:$B);ANZAHL2('1'!$2:$2))

Sub Format1()
Application.Goto Reference:="=BEREICH.VERSCHIEBEN('1'!$B$2;;;ANZAHL2('1'!$B:$B);ANZAHL2('1'!$2:$2))"
Dim i As Long
For i = 1 To Cells(Rows.Count, 6).End(xlUp).Row 'letzte Zeile in Spalte F
'korrigieren    If Cells(i, 6) Formula1:="=UND($F5=""2x/Woche"";P5=""X"")"" Then  'wenn in Spalte F und P diese Begriffe
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 2
End With
With Rows(i).Borders(xlEdgeBottom)  'ganze Zeile (auch leere Zellen) gepunkteter Unterstrich
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
'korrigieren    elseIf Cells(i, 6) Formula1:="=UND($F5=""1x/Woche"";P5=""X"")" Then  'wenn in Spalte F und P diese Begriffe
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 2
End With
Selection.FormatConditions(2).Interior.ColorIndex = 5
With Rows(i).Borders(xlEdgeBottom)  'ganze Zeile gepunkteter Unterstrich
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
'korrigieren    elseIf Cells(i, 6) Formula1:="=UND($F5=""1x/Monat"";P5=""X"")" Then  'wenn in Spalte F und P diese Begriffe
With Selection.FormatConditions(3).Font
.Bold = True
.Italic = False
.ColorIndex = 2
End With
Selection.FormatConditions(3).Interior.ColorIndex = 1
With Rows(i).Borders(xlEdgeBottom)  'ganze Zeile gepunkteter Unterstrich
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Else
Rows(i).Borders(xlEdgeBottom).LineStyle = xlNone
End If
Next i
End Sub

Hilfe wäre prima. Danke!
Gruß
Horst

26
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Formula bed. Format
05.12.2005 14:22:14
Harald
Hallo Horst,
mag sein, dass ich das falsch verstanden habe. Aber ich würd die bedingte Formatierung gegen Select Case austauschen
i ist der zeilenzähler und die Kriterien sind in Zeile i Spalte 5 und Spalte 16
Beide zeilen zusammen: Cells(i, 5) & Cells(i, 16)
ergeben dann z.B. "2x/WocheX"
und das würde ich abklopfen
Hier das Schema

Sub test1()
For i = 1 To Cells(Rows.Count, 6).End(xlUp).Row 'letzte Zeile in Spalte F
Select Case Cells(i, 5) & Cells(i, 16)
Case Is = "2x/WocheX"
With Range(Cells(i, 1), Cells(i, 16)) 'oder Rows(i)
'deine Formatierungen
End With
Case Is = "1x/WocheX"
With Range(Cells(i, 1), Cells(i, 16))
'deine Formatierungen
End With
'usw
Case Else 'alles andere
Cells(i, 16).Interior.ColorIndex = xlNone
'weitere Bedingungen
End Select
Next i
End Sub

Gruss Harald
Anzeige
AW: VBA Formula bed. Format
05.12.2005 14:48:40
Horst
Hallo Harald,
danke erst einmal. Noch *ne Frage: Wenn der Bereich des vorkommenden "X" von Row 16 bis Row 76 geht, kann ich ja nicht mit 16:76 arbeiten. Wie gebe ich das an? Bist du mir bitte noch behilflich? Danke.
For i = 1 To Cells(Rows.Count, 6).End(xlUp).Row 'letzte Zeile in Spalte F
Select Case Cells(i, 5) & Cells(i, 16)
Case Is = "2x/WocheX"
With Range(Cells(i, 1), Cells(i, 16)) 'oder Rows(i)
'deine Formatierungen
End With
AW: VBA Formula bed. Format
05.12.2005 15:05:39
Horst
Hallo Harald,
vergaß den Gruß. Sorry. Kannst du mir auch noch abschließend sagen, wie ich die Zeile mit dem Formula richtig schreibe. Meine Versuche missglücken immer. Wäre toll, wenn du meine Vorantwort (Frage von 14:48 h) und diese beantworten würdest. Danke und Gruß.Horst
Wenn ich dich richtig verstanden habe:
Sub test1()
For i = 1 To Cells(Rows.Count, 6).End(xlUp).Row 'letzte Zeile in Spalte F
Select Case Cells(i, 5) & Cells(i, 16)
Case Is = "2x/WocheX"
With Range(Cells(i, 1), Cells(i, 16)) 'oder Rows(i)
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 2
End With
With Rows(i).Borders(xlEdgeBottom) 'ganze Zeile (auch leere Zellen) gepunkteter Unterstrich
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Case Is = "1x/WocheX"
With Range(Cells(i, 1), Cells(i, 16))
'deine Formatierungen
End With
'usw. mit den nächsten beiden Formatierungen
Oder wird das mit den Rows extra gemacht? Aber wie gefragt - wie implizier ich den Bereich für die "X"?
Anzeige
AW: VBA Formula bed. Format
05.12.2005 15:56:14
Harald
Case Is = "2x/WocheX"
With Range(Cells(i, 16), Cells(i, 76))
.Font.Bold = True
.font.Italic = False
.interior.ColorIndex = 2
End With
With Rows(i).Borders(xlEdgeBottom) 'ganze Zeile (auch leere Zellen) gepunkteter Unterstrich
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
dürfte funzen
Die andere Frage versteh ich nicht. Wo kann den nun ein X stehen. In Spalte P oder in Zeile 16 bis 76 egalwo ?
Dann bin ich überfragt.
Oder soll sich die Formatierung auf den Bereich beziehen ?
Das wäre dann wie oben im range angegeben.
Kann erst wieder morgen reinschauen
Gruß
Harald
Anzeige
AW: VBA Formula bed. Format
06.12.2005 10:30:38
Horst
Guten Morgen Harald,
vielleicht habe ich mich etwas unglücklich ausgedrückt:
im dyn. Bereich =BEREICH.VERSCHIEBEN('1'!$B$2;;;ANZAHL2('1'!$B:$B);ANZAHL2('1'!$2:$2))
habe ich die Spalte 6, die aufgrund 3 versch. Texte die Formatierung steuern soll. Zeilen vorhanden, dann steht in Spalte 6 immer etwas. Hinzu kommt als 2. Bedingung der Bereich von Spalte 15 bis 76, worin unregelmäßig X als Eingaben zu finden sind. Wenn beide Kriterien zutreffen, dann soll die Zelle background entspr. farbig und Schrift weiß. Nur im Bereich Spalte 15 bis Spalte 76. Insgesamt soll aber, wenn Zeilen (wenn Spalte 6 gefüllt) die ganze Zeile unterpunktet werden von Spalte 2 bis Spalte 78.
Der gesamte Bereich von Spalte 2 bis Spalte 78 soll zudem die Schrift gem. Kriterium Spalte 6 farbig werden.
Format1:
wenn in Spalte 6 "2x/Woche" dann Schrift Gesamtbereich (Spalte 2 bis Spalte 78)ROT Fett
wenn in Spalte 6 "1x/Woche" dann Schrift Gesamtbereich (Spalte 2 bis Spalte 78)BLAU Fett
wenn in Spalte 6 "1x/Monat" dann Schrift Gesamtbereich (Spalte 2 bis Spalte 78)SCHWARZ Fett
wenn Spalte 6 "" dann Gesamtbereich Zeilen unterpunktet schwarz
Format2:
wenn in Spalte 6 "2x/Woche" Zelle Teilbereich (Spalte 15 bis Spalte 76) background ROT und Schrift WEIß Fett, unterpunktet soll bleiben
wenn in Spalte 6 "1x/Woche" Zelle Teilbereich (Spalte 15 bis Spalte 76) background BLAU und Schrift WEIß Fett, unterpunktet soll bleiben
wenn in Spalte 6 "1x/Monat" Zelle Teilbereich (Spalte 15 bis Spalte 76) background SCHWARZ und Schrift WEIß Fett, unterpunktet soll bleiben
Anmerkung: Der Teilbereich (Spalte 15 bis Spalte 78) besteht aus fortlaufenden Datumsspalten (jedes Datum 2 x), wobei in der jeweils 1 Spalte X eingegeben kann und in der jeweiligen 2.ten Spalte eine Zahl. Wird also in der jeweiligen 1. Spalte (15, 17, 19, etc.) ein X eingetragen, so soll sich die Zelle in der Farbe gem. Spalte 6 färben und das X fett weiß werden; in der jeweils 2.ten Spalte (16, 18, 20, etc.) werden Zahlen eingeben.
Vielleicht etwas viel erklärt, aber so ist der Gedanke. Das ganze dient für Pivot, Grafiken und Druckauswertungen. Wichtig ist, dass der Bereich dyn. bleibt, denn es sind mehrere Tabellen gleichen Aufbaus (12 Register Monate), aber unterschiedl. Zeilenanzahl.
Kann man ein Makro über alle 12 Registerblätter legen?
PS: Aufgrund deines freundl. Hinweis antworte ich erst jetzt. Schau dir das doch bitte noch einmal an. Sicher hilft die meine ausführliche Erklärung, meinen Gedanken zu verfolgen. Wäre PRIMA, wenn du mir scripttechnisch hilfst!!! Als Anfänger hab ich das einfach noch nicht drauf. Danke für deine Rückmeldung!
Gruß
Horst
Anzeige
AW: VBA Formula bed. Format
06.12.2005 11:45:08
Harald
Hi Horst,
die Sache mit dem dynamischen Bereich hab ich noch nie gesehen.
Wenn es lediglich die Anzahl der Zeilen sind, die variieren, kann man die Anzahl
auch anders ermitteln. Siehe Lrow im Code Xen
Schritt für Schritt. Hier ein Code, der dir im angegebenen Bereich x oder X sucht und nach Wunsch formatiert.

Sub Xen()
Dim rng As Range
Dim Lrow As Long
Lrow = Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zelle in Spalte A
'Für jede Zelle im Bereich Spalte 15 bis 76, Zeile 2 bis letzte
For Each rng In Range("O2:BX" & Lrow)
'wenn Eintrag (in Kleinschreibung gewandelt) = x dann....
If LCase(rng) = "x" Then
rng.Font.Bold = True 'fett
rng.Font.ColorIndex = 2 'weiß
'weitere
End If
End Sub

Wenn Du eine Zeile im Suchbereich auf x prüfen willst (per Schleife)

Sub anzahlX()
Dim Lrow As Long, i As Long
Lrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Lrow
If WorksheetFunction.CountIf(Range(Cells(x, 15), Cells(x, 76)), LCase("x")) >= 1 Then
'with range(cells....usw).deine Formatierungen
End If
Next i
End Sub

oder das select case dort noch einbauen ;-)) (na, passt es noch in den Schädel ?)
Ich darf ja garnicht grinsen, da selbst noch Anfänger.
Als Variante. Wenn er zwischen Spalte 15 und 76 mindestens ein x findet, ruft er die select case geschichte auf, in der du die Angabe in Spalte 6 (1x/Woche...etc) abklopfst.

Sub anzahlX()
Dim Lrow As Long, i As Long
Lrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Lrow
If WorksheetFunction.CountIf(Range(Cells(x, 15), Cells(x, 76)), LCase("x")) >= 1 Then
Call Wochenschau
'die Select case Anwendung im gleichen Modul unter 


Sub Wochenschau speichern
End If
Next i
End Sub



Mit der Call Anweisung kannst Du einen unübersichlichen Code in mehrere Einzel-Codes aufteilen. Macht es IMHO übersichtlicher. Kannst die Select Case Anwendung aber auch gerne statt Call Wochenschau direkt in den Code schreiben.

Hoffe das hilft. Mehr als vba-Hausmannskost ist bei mir eben nicht zu holen ;-))

Gruss Harald
Anzeige
AW: VBA Formula bed. Format
06.12.2005 13:16:36
Horst
Hallo Harald,
danke für deine Mühe!
Ich muss das in Ruhe durchdenken und versuche, das "Richtige" entsprechend ein- und anzupassen. Übrigens: Gute Erklärungsweise. Ich werde dann testen, ob ich es richtig gemacht habe. Evtl. würde ich bei gravierendem Problem noch einmal rückfragen dürfen.
Ich danke dir auch für das prompte Antworten! Find ich anständig.
Gruß aus Bremen. Horst
Danke für die Rückmeldung
06.12.2005 13:25:12
Harald
...und viel Erfolg.
Schritt für Schritt wird das schon.
Gruss Harald
AW: Danke für die Rückmeldung
06.12.2005 14:37:18
Horst
Hallo Harald,
habe versucht anzupassen, jedoch bekomme ich die 1. Fehlermeldung bei
' If WorksheetFunction.CountIf(Range(Cells(x, 15), Cells(x, 76)), LCase("x")) >= 1 Then
und wenn ich das 

Sub wochenschau alleine laufen lasse - auch null Reaktion.
Schau mal:


Sub anzahlX()
Dim Lrow As Long, i As Long
Lrow = Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To Lrow
If WorksheetFunction.CountIf(Range(Cells(x, 15), Cells(x, 76)), LCase("x")) >= 1 Then
Call wochenschau
End If
Next i
End Sub



' Formatierung, wenn in Spalte 6 Begriff (2x/Woche etc.) und dazu im Bereich Spalte 15 bis Spalte 76 ein "x" gefunden wird

' Ziel ist: 2x/Woche+x=Rote Zelle, Schrift weiß fett; 1x/Woche+x=Blaue Zelle, Schrift weiß fett; 1x/Monat+"x"=Schwarze Zelle, Schrift weiß fett



Sub wochenschau()
For i = 1 To Cells(Rows.Count, 6).End(xlUp).Row 'letzte Zeile in Spalte F
Select Case Cells(i, 6)
Case Is = "2x/Wochex"
With Range(Cells(i, 6) & Range(Cells(i, 15), Cells(i, 76)))
.Font.Bold = True
.Font.Italic = False
.ColorIndex = 2
.Interior.ColorIndex = 3
End With
With Rows(i).Borders(xlEdgeBottom) 'ganze Zeile (auch leere Zellen) gepunkteter Unterstrich
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Case Is = "1x/Wochex"
With Range(Cells(i, 6) & Range(Cells(i, 15), Cells(i, 76)))
.Font.Bold = True
.Font.Italic = False
.ColorIndex = 2
.Interior.ColorIndex = 5
End With
With Rows(i).Borders(xlEdgeBottom) 'ganze Zeile (auch leere Zellen) gepunkteter Unterstrich
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Case Is = "1x/Monatx"
With Range(Cells(i, 6) & Range(Cells(i, 15), Cells(i, 76)))
.Font.Bold = True
.Font.Italic = False
.ColorIndex = 2
.Interior.ColorIndex = 1
End With
With Rows(i).Borders(xlEdgeBottom) 'ganze Zeile (auch leere Zellen) gepunkteter Unterstrich
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Case Else 'alles andere
Cells(i, 6).Interior.ColorIndex = xlNone
End Select
Next i
End Sub



anscheinend ist meine Verknüpfung (Spalte 6 und gleichzeitig aus Bereich Spalte 15 bis 76) nicht korrekt ? bekomme aber keinerlei fehlermeldung. Was sagst du dazu?

Gruß Horst
Anzeige
AW: Danke für die Rückmeldung
06.12.2005 14:51:56
Harald
4 Fehler

Sub anzahlX()
Dim Lrow As Long, i As Long
Lrow = Cells(Rows.Count, 1).End(xlUp).Row
'möglicher Fehler1: ist in Spalte A überhaupt die letzte gefüllte Zelle?
For i = 2 To Lrow  'Fehler 2 hier benutzt du i, eine Zeile weiter x !!
If WorksheetFunction.CountIf(Range(Cells(x, 15), Cells(x, 76)), LCase("x")) >= 1 Then
Call wochenschau
End If
Next i 'Fehler 3 auch hier muss dann ein i
End Sub

4. Fehler
In der Select Case-Abfrage fragst Du nach
Case Is = "1x/Wochex"
in Spalte 6
Da du aber das X schon vorher abfrags und
Select Case Cells(i, 6) definiert ist, darfst Du nur
nach
Case Is = "1x/Woche"
fragen (ohne nachfolgendes x)
So. hab nu Feierabend. Aber ich schau nachher zuhause nochmal rein. Dürfte aber so laufen
Viel Glück
Gruss Harald
Anzeige
AW: Danke für die Rückmeldung
06.12.2005 14:57:15
Horst
Lieber Harald,
hast wie ich die Ruhe weg. Danke für deine GEDULD !!
Wünsche wohl verdienten Feierabend!
Gruß
Horst
PS: Anfänger blicken halt noch nicht so durch.
Oha
06.12.2005 15:38:27
Harald
Fiel mir glühend heiß im Auto ein.
Es muss alles in einen Code, wegen der Vaiablen. i oder x nimmt er nicht mit in den zweiten Code und dort käme es dann zu einer Überschneidung.
Also statt Call Wochenschau, den Code in Sub AnzahlX integrieren und die Variable nur einmal deklarieren.
Harald
AW: VBA Formula bed. Format
06.12.2005 13:16:40
Horst
Hallo Harald,
danke für deine Mühe!
Ich muss das in Ruhe durchdenken und versuche, das "Richtige" entsprechend ein- und anzupassen. Übrigens: Gute Erklärungsweise. Ich werde dann testen, ob ich es richtig gemacht habe. Evtl. würde ich bei gravierendem Problem noch einmal rückfragen dürfen.
Ich danke dir auch für das prompte Antworten! Find ich anständig.
Gruß aus Bremen. Horst
Anzeige
AW: VBA Formula bed. Format
06.12.2005 13:29:54
Harald
Ahja...die gute Beate.
Pivot und ich werden wohl nie Freunde werden ;-))
Daher würd ich den Bereich so lassen wie er ist und die Formatierungen davon losgelöst über normale Schleifen abwickeln.
Gruss Harald
AW: VBA Formula bed. Format
07.12.2005 13:06:42
Horst
Hallo Harald,
habe mich bemüht - aber ich bekomme es noch nicht "gebacken". Würdest Du dir das bitte noch einmal anschauen? Habe immer noch Fehler drin. Wäre prima!! Gruß Horst

Sub anzahlX()
Dim Lrow As Long, i As Long
Lrow = Cells(Rows.Count, 6).End(xlUp).Row  'Letzte in Spalte F
For x = 2 To Lrow
If WorksheetFunction.CountIf(Range(Cells(x, 15), Cells(x, 76)), LCase("x")) >= 1 Then
'Call wochenschau
For i = 1 To Cells(Rows.Count, 6).End(xlUp).Row 'letzte Zeile in Spalte F
Select Case Cells(i, 6)
Case Is = "2x/Wochex"
With Range(Cells(i, 6) & Range(Cells(i, 15), Cells(i, 76)))
.Font.Bold = True
.Font.Italic = False
.ColorIndex = 2
.Interior.ColorIndex = 3
End With
With Rows(i).Borders(xlEdgeBottom) 'ganze Zeile (auch leere Zellen) gepunkteter Unterstrich
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Case Is = "1x/Wochex"
With Range(Cells(i, 6) & Range(Cells(i, 15), Cells(i, 76)))
.Font.Bold = True
.Font.Italic = False
.ColorIndex = 2
.Interior.ColorIndex = 5
End With
With Rows(i).Borders(xlEdgeBottom) 'ganze Zeile (auch leere Zellen) gepunkteter Unterstrich
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Case Is = "1x/Monatx"
With Range(Cells(i, 6) & Range(Cells(i, 15), Cells(i, 76)))
.Font.Bold = True
.Font.Italic = False
.ColorIndex = 2
.Interior.ColorIndex = 1
End With
With Rows(i).Borders(xlEdgeBottom) 'ganze Zeile (auch leere Zellen) gepunkteter Unterstrich
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Case Else 'alles andere
Cells(i, 6).Interior.ColorIndex = xlNone
End Select
Next i
End If
Next i
End Sub

Anzeige
AW: VBA Formula mit Datei
07.12.2005 13:34:14
Horst
Hallo Harald,
habe mich bemüht - aber ich bekomme es noch nicht "gebacken". Würdest Du dir das bitte noch einmal anschauen? Habe immer noch Fehler drin. Wäre prima!! Gruß Horst
als Wertetabelle https://www.herber.de/bbs/user/29022.xls

Sub anzahlX()
Dim Lrow As Long, i As Long
Lrow = Cells(Rows.Count, 6).End(xlUp).Row  'Letzte in Spalte F
For x = 2 To Lrow
If WorksheetFunction.CountIf(Range(Cells(x, 15), Cells(x, 76)), LCase("x")) >= 1 Then
'Call wochenschau
For i = 1 To Cells(Rows.Count, 6).End(xlUp).Row 'letzte Zeile in Spalte F
Select Case Cells(i, 6)
Case Is = "2x/Wochex"
With Range(Cells(i, 6) & Range(Cells(i, 15), Cells(i, 76)))
.Font.Bold = True
.Font.Italic = False
.ColorIndex = 2
.Interior.ColorIndex = 3
End With
With Rows(i).Borders(xlEdgeBottom) 'ganze Zeile (auch leere Zellen) gepunkteter Unterstrich
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Case Is = "1x/Wochex"
With Range(Cells(i, 6) & Range(Cells(i, 15), Cells(i, 76)))
.Font.Bold = True
.Font.Italic = False
.ColorIndex = 2
.Interior.ColorIndex = 5
End With
With Rows(i).Borders(xlEdgeBottom) 'ganze Zeile (auch leere Zellen) gepunkteter Unterstrich
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Case Is = "1x/Monatx"
With Range(Cells(i, 6) & Range(Cells(i, 15), Cells(i, 76)))
.Font.Bold = True
.Font.Italic = False
.ColorIndex = 2
.Interior.ColorIndex = 1
End With
With Rows(i).Borders(xlEdgeBottom) 'ganze Zeile (auch leere Zellen) gepunkteter Unterstrich
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Case Else 'alles andere
Cells(i, 6).Interior.ColorIndex = xlNone
End Select
Next i
End If
Next x
End Sub

AW: VBA Formula bed. Format
07.12.2005 13:52:11
Harald
Jau. Ich habs mal provisorisch nachgebaut und den Code überarbeitet.
Waren einige Änderungen. Hab an den relevanten Stellen Kommentare dazugeschrieben

Sub anzahlX()
Dim Lrow As Long, i As Long
Lrow = Cells(Rows.Count, 6).End(xlUp).Row  'Letzte in Spalte F
'Variable x gelöscht, geht alles mit einer Variablen i
For i = 2 To Lrow
If WorksheetFunction.CountIf(Range(Cells(i, 15), Cells(i, 76)), LCase("x")) >= 1 Then
Select Case Cells(i, 6)
'2x/Wochex hätte er in Spalte F nicht gefunden, also das letzte x weg
Case Is = "2x/Woche"
'With Anweisung aufgesplittet
With Cells(i, 6)
.Font.Bold = True
.Font.Italic = False
.Font.ColorIndex = 2
.Interior.ColorIndex = 3
End With
With Range(Cells(i, 15), Cells(i, 76))
.Font.Bold = True
.Font.Italic = False
.Font.ColorIndex = 2
.Interior.ColorIndex = 3
End With
With Rows(i).Borders(xlEdgeBottom) 'ganze Zeile (auch leere Zellen) gepunkteter Unterstrich
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Case Is = "1x/Woche"
With Cells(i, 6)
.Font.Bold = True
.Font.Italic = False
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
End With
With Range(Cells(i, 15), Cells(i, 76))
.Font.Bold = True
.Font.Italic = False
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
End With
With Rows(i).Borders(xlEdgeBottom) 'ganze Zeile (auch leere Zellen) gepunkteter Unterstrich
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Case Is = "1x/Monat"
With Cells(i, 6)
.Font.Bold = True
.Font.Italic = False
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
End With
With Range(Cells(i, 15), Cells(i, 76))
.Font.Bold = True
.Font.Italic = False
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
End With
With Rows(i).Borders(xlEdgeBottom) 'ganze Zeile (auch leere Zellen) gepunkteter Unterstrich
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Case Else 'alles andere
Cells(i, 6).Interior.ColorIndex = xlNone
End Select
'wenn Zählergebnis der x kleiner 1, keine Farbe, keine Linie, keine Fettschrift, keine Kekse ;-))
Else
With Rows(i)
.Interior.ColorIndex = xlNone
.Font.ColorIndex = xlAutomatic
.Font.Bold = False
.Borders(xlEdgeBottom).LineStyle = xlNone
End With
End If
Next i
End Sub

Gruss Harald
AW: VBA Formula bed. Format
07.12.2005 14:00:48
Horst
Hallo Harald,
ist schon viel feiner. Wenn jetzt nur noch die einzelne Zelle (da wo ein x reingetippt wird, nur farbig wir anstelle des ganzen Bereichs in der Zeile - das wäre top. Muss da eine begrenzung rein? Gruss Horst PS: habe in der Vormail sheet hochgeladen wegen der Optik.
AW: VBA Formula bed. Format
07.12.2005 14:27:37
Harald
Dann so
Dann haben wir noch ne Variable x, die in einer inneren Schleife alle x - Zellen zwischen Spalte 15 und 76 der betreffenden Zeile entsprechend formatiert.

Sub anzahlX()
Dim Lrow As Long, i As Long, x As Integer
Lrow = Cells(Rows.Count, 6).End(xlUp).Row  'Letzte in Spalte F
For i = 2 To Lrow
If WorksheetFunction.CountIf(Range(Cells(i, 15), Cells(i, 76)), LCase("x")) >= 1 Then
'Call wochenschau
'For i = 1 To Cells(Rows.Count, 6).End(xlUp).Row 'letzte Zeile in Spalte F
Select Case Cells(i, 6)
Case Is = "2x/Woche"
With Cells(i, 6)
.Font.Bold = True
.Font.Italic = False
.Font.ColorIndex = 2
.Interior.ColorIndex = 3
End With
For x = 15 To 76
If Cells(i, x) = LCase("x") Then
With Cells(i, x)
.Font.Bold = True
.Font.Italic = False
.Font.ColorIndex = 2
.Interior.ColorIndex = 3
End With
End If
Next x
With Rows(i).Borders(xlEdgeBottom) 'ganze Zeile (auch leere Zellen) gepunkteter Unterstrich
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Case Is = "1x/Woche"
With Cells(i, 6)
.Font.Bold = True
.Font.Italic = False
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
End With
For x = 15 To 76
If Cells(i, x) = LCase("x") Then
With Cells(i, x)
.Font.Bold = True
.Font.Italic = False
.Font.ColorIndex = 2
.Interior.ColorIndex = 5
End With
End If
Next x
With Rows(i).Borders(xlEdgeBottom) 'ganze Zeile (auch leere Zellen) gepunkteter Unterstrich
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Case Is = "1x/Monat"
With Cells(i, 6)
.Font.Bold = True
.Font.Italic = False
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
End With
For x = 15 To 76
If Cells(i, x) = LCase("x") Then
With Cells(i, x)
.Font.Bold = True
.Font.Italic = False
.Font.ColorIndex = 2
.Interior.ColorIndex = 1
End With
End If
Next x
With Rows(i).Borders(xlEdgeBottom) 'ganze Zeile (auch leere Zellen) gepunkteter Unterstrich
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Case Else 'alles andere
Cells(i, 6).Interior.ColorIndex = xlNone
End Select
Else
With Rows(i)
.Interior.ColorIndex = xlNone
.Font.ColorIndex = xlAutomatic
.Font.Bold = False
.Borders(xlEdgeBottom).LineStyle = xlNone
End With
End If
Next i
End Sub

Gruss Harald
AW: VBA Formula bed. Format
07.12.2005 14:50:03
Horst
Hallo Harald,
das ist fein! Abschlussfrage: kann ich einen refresh-befehl nach dem letzten next i einfügen, damit bei Eingaben von x sich dann auch gleich die Formatierung ergibt - also stetig eine bedingte Formatierung im HIntergrund ist?
Gruß Horst
AW: VBA Formula bed. Format
07.12.2005 15:39:30
Harald
Klar.
Soll der ganze Code ausgeführt werden, wenn dort ein x eingetragen oder gelöscht wird ?
Dann nutze ein Worksheet-Ereignis (im Blattmodul im PopUp-Fenster ALLGEMEIN) auf Worksheet wechseln und rechts daneben das Ereignis wählen)
In diesem Fall z.B. Worksheet_Change
Noch ne Begrenzung rein (mal frei Schnauze)
if target.count &gt 1 then exit sub
If target.row = 1 or target.column &lt15 or target.column &gt76 then exit sub
und Call anzahlX
Soll nur das x formatiert werden, muss man was Ähnliches stricken.
Muss ich morgen auffe Arbeit machen (da ist meine vba_Hausapotheke)
Gruß
Harald
AW: VBA Formula bed. Format
08.12.2005 08:02:33
Harald
Moin Horst,
der Code kommt ins Blattmodul des betreffenden Arbeitsblatt. anzahlX kann im Standardmodul bleiben.
Der Code reagiert, wenn im Bereich P2:BX letzte Zeile Spalte F eine Änderung erfolgt (Eingabe oder Löschen)

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
'Abbruchkriterien
If Target.Row = 1 Or Target.Column < 15 Or Target.Column > 76 Then Exit Sub
'Gültigkeitsbereich
LrowA = Cells(Rows.Count, 6).End(xlUp).Row
Set rng = Range("P2:BX" & LrowA)
'wenn Änderung im Gültigkeitsbereich, dann anzahlX aufrufen
If Not Intersect(Target, rng) Is Nothing Then
Call anzahlX
End If
End Sub

Gruss Harald
AW: VBA Formula bed. Format
09.12.2005 10:50:23
Horst
Vorab Schönes Wochenende, Harald, und Danke. War gestern nicht im Büro und at home z. Z. kein i-net. Danke erst einmal für dein Engagement. Werde das worksheet_change ausprobieren. Wollte mich nur gleich melden. Wenn es denn so läuft und verhält, ist das genau das, was mir noch fehlte. Habe in der Recherche versucht zu finden, wie man via VBA beim Öffnen der Mappe (12 Monatsregister 1 bis 12) mit dem "Zeiger" beim "heutigen" Datum landet und er das sheet öffnet. Ist in deiner Hausapotheke so etwas? Wenn ich dein script anzahlX in anderer version mit Formeln anstelle Formatierung ausstatte, müsste das doch auch funktionieren. So könnte ich zusätzlich das x durch das Datum (Spaltenüberschriften in Zeile 2) ersetzen. Hast du eine Idee, wie man das angeht, wenn nun die Begriffe in Spalte 2 (Straßen) die dazugehörigen Data (Datum plural) erhalten und das Ganze dann eine Liste werden soll, in der die Straßen häufig mehrmals vorkommen, jedoch mit unterschiedlichen Datumswerten? Bin am doktern - muss wohl noch ein wenig überlegen und üben:-) - nun aber erst einmal Danke für deine Mühe und melde mich rück.
Gruß Horst
AW: VBA Formula bed. Format
09.12.2005 12:37:51
Harald
Hi Horst,

Private Sub Workbook_Open()
Dim i As Integer, x As Integer
For i = 1 To Sheets.Count  'für alle Blätter dieser Mappe
For x = 2 To 32  'Spalte B bis AG
If Worksheets(i).Cells(1, x) = Date Then  ' in Zeile 1
Sheets(i).Activate
Cells(1, x).Activate
GoTo ende:
End If
Next x
Next i
ende:
End Sub

Bezüglich der anderen Anfragen.
Betrachte die Dinge einzeln und mach dazu jeweils einen neuen Thread auf (immer bedenken, dass Problem anschaulich zu beschreiben), den dieser Thread wandert demnäx ins Archiv.
Wünsche ebenfalls schönes WE und Gruss Harald
AW: VBA Formula bed. Format
09.12.2005 12:19:17
Horst
Hallo Harald,
hab nun doch eine Routine gefunden:

Sub go_auto_today()
Application.ScreenUpdating = False
For Each a In ActiveSheet.Range("O2:BX2") 'Bereich des Datums
If a = Date Then
Spalte = a.Column
Exit For
End If
Next
On Error Resume Next
Application.Goto ActiveSheet.Cells(2, Spalte), True
If Err.Number <> 0 Then
Msgbox ("Das aktuelle Datum (HEUTE) wurde nicht gefunden.")
End If
Application.ScreenUpdating = True
End Sub

PS Suchbegriffe in der Recherche bisserl verdreht.
Stelle die Frage nach mehrere Register durchsuchen in neuen thread - bist mir 'eh schon sehr gefällig. Danke!!
Guß Horst

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige