Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 23:47:55
Datum ausweisen, wenn definierte Summe erreicht ist
25.04.2024 21:40:53
Excel Datenquelle aus dem Web mit Anmeldung?
25.04.2024 21:21:16
Zellkommentar in UserForm anzeigen und bearbeiten
25.04.2024 21:13:13
Kalenderwochen addieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1292to1296
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
1292to1296
1292to1296
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Formatierung durch Inhalt einer anderen zelle

Formatierung durch Inhalt einer anderen zelle
09.01.2013 15:12:13
Hugo
Hallo Leute,
ich habe einen Dienstplan erstellt, wo die Zellen der Arbeitszeiten mittels einem Code eingefärbt werden (z.B. wird die 1 eingegeben, dann wird die Zelle rot eingefärbt (hintergrundfarbe und Schriftfarbe) 15 verschiedene Möglichkeiten stehen zur Verfügung.
Folgendes soll geschehen:
1. Name, Schicht und Ort sind ausgewählt
2. die Zelle mit der Arbeitszeit wird mittels Zahl eingefärbt
3. Automatsich soll Name, Schicht und Ort mit der gleichen Farbe formatiert werden (Hintergrundfarbe + Schriftfarbe schwarz) wie jene, die für die Einfärbung der Zellen benutzt wurde.
Ich hoffe, dass ich mich verständlich ausgedrückt habe.
Danke für die Hilfe
LG aus Italien
Huffi

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Formatierung durch Inhalt einer anderen zelle
09.01.2013 15:21:42
Klaus
Hi Hugo,
erweitere dein worksheet_change Makro entsprechend:
Option Explicit
Dim Bereich1 As Range
Private Sub Worksheet_Change(ByVal Target As Range)
Dim actCell As Range
Dim Bereich2 As Range
Set Bereich2 = Range("H4:Ab71")
Application.ScreenUpdating = False
For Each actCell In Bereich1
If Not Intersect(actCell, Bereich2) Is Nothing Then
Select Case actCell
Case "": actCell.Interior.ColorIndex = 2
Case "1": actCell.Interior.ColorIndex = 3
Case "2": actCell.Interior.ColorIndex = 4
Case "3": actCell.Interior.ColorIndex = 5
Case "4": actCell.Interior.ColorIndex = 6
Case "5": actCell.Interior.ColorIndex = 7
Case "6": actCell.Interior.ColorIndex = 8
Case "7": actCell.Interior.ColorIndex = 9
Case "8": actCell.Interior.ColorIndex = 10
Case "9": actCell.Interior.ColorIndex = 11
Case "10": actCell.Interior.ColorIndex = 12
Case "11": actCell.Interior.ColorIndex = 13
Case "12": actCell.Interior.ColorIndex = 14
Case "13": actCell.Interior.ColorIndex = 15
Case "14": actCell.Interior.ColorIndex = 16
Case "15": actCell.Interior.ColorIndex = 17
End Select
        Select Case actCell
Case "": Range(Cells(actCell.Row, 4), Cells(actCell.Row, 6)).Interior.ColorIndex =  _
2
Case "1": Range(Cells(actCell.Row, 4), Cells(actCell.Row, 6)).Interior.ColorIndex =  _
3
Case "2": Range(Cells(actCell.Row, 4), Cells(actCell.Row, 6)).Interior.ColorIndex =  _
4
Case "3": Range(Cells(actCell.Row, 4), Cells(actCell.Row, 6)).Interior.ColorIndex =  _
5
Case "4": Range(Cells(actCell.Row, 4), Cells(actCell.Row, 6)).Interior.ColorIndex =  _
6
Case "5": Range(Cells(actCell.Row, 4), Cells(actCell.Row, 6)).Interior.ColorIndex =  _
7
Case "6": Range(Cells(actCell.Row, 4), Cells(actCell.Row, 6)).Interior.ColorIndex =  _
8
Case "7": Range(Cells(actCell.Row, 4), Cells(actCell.Row, 6)).Interior.ColorIndex =  _
9
Case "8": Range(Cells(actCell.Row, 4), Cells(actCell.Row, 6)).Interior.ColorIndex =  _
10
Case "9": Range(Cells(actCell.Row, 4), Cells(actCell.Row, 6)).Interior.ColorIndex =  _
11
Case "10": Range(Cells(actCell.Row, 4), Cells(actCell.Row, 6)).Interior.ColorIndex = _
12
Case "11": Range(Cells(actCell.Row, 4), Cells(actCell.Row, 6)).Interior.ColorIndex = _
13
Case "12": Range(Cells(actCell.Row, 4), Cells(actCell.Row, 6)).Interior.ColorIndex = _
14
Case "13": Range(Cells(actCell.Row, 4), Cells(actCell.Row, 6)).Interior.ColorIndex = _
15
Case "14": Range(Cells(actCell.Row, 4), Cells(actCell.Row, 6)).Interior.ColorIndex = _
16
Case "15": Range(Cells(actCell.Row, 4), Cells(actCell.Row, 6)).Interior.ColorIndex = _
17
End Select

End If
Next
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set Bereich1 = Selection
End Sub
LG zurück aus Estland,
Klaus M.vdT.

Anzeige
AW: Formatierung durch Inhalt einer anderen zelle
11.01.2013 09:41:38
Hugo
Hallo Klaus,
es funktioniert hervorragend und ich bin Dir sehr dankbar für Deine Hilfe.
Wäre es Z.B. auch möglich, dass es bei Eingabe einer Farbe(mittels Zahl) die restlichen Zellen innerhalb der Zeile nicht mit einer anderen Farbe (Zahl) belegt werden kann.
Z.B. ich gebe in der Zelle H4 die Zahl 1 ein, in der Zeile 4 kann nur die Zahl 1 eingegeben werden, wird eine andere Zahl eingegeben, so wird diese nicht angenommen.
Vielen Dank
Hugo

AW: Formatierung durch Inhalt einer anderen zelle
11.01.2013 10:41:00
Klaus
Hi,
klar geht das auch. Ist zwar eine völlig andere Fragestellung und hätte ein eigenen Thread haben dürfen, aber egal:
Option Explicit
Dim Bereich1 As Range
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo hell  'Bei Fehler events wieder anschalten!
Dim actCell As Range
Dim Bereich2 As Range
Dim iColor As Integer
Set Bereich2 = Range("H4:AB71")
Application.ScreenUpdating = False
For Each actCell In Bereich1
If Not Intersect(actCell, Bereich2) Is Nothing Then
'prüfen, ob bereich leer bzw ob zahl zulässig
If Application.WorksheetFunction.Sum(Range(Cells(actCell.Row, Bereich2.Column), Cells( _
actCell.Row, Bereich2.Columns.Count))) - actCell.Value = 0 Then
'erster eintrag, immer zulassen
Else
'wenn der Beitrag gleich einem anderem Beitrag im Bereich ist, dann
If actCell.Value = Application.WorksheetFunction.Average(Range(Cells(actCell.Row,  _
Bereich2.Column), Cells(actCell.Row, Bereich2.Columns.Count))) Then
'nix, zulassen
Else
'verhindern
MsgBox ("Eintrag ungültig!")
Application.EnableEvents = False
actCell.Value = ""
actCell.Select
Application.EnableEvents = True
'Eintrag zu löschen löst erneut das "change" Ereigniss aus
'Events kurz abschalten, um das zu verhindern!
End If
End If
'aktive Zelle und 3 Zellen links einfärben
Select Case actCell
Case "": iColor = 2
Case "1": iColor = 3
Case "2": iColor = 4
Case "3": iColor = 5
Case "4": iColor = 6
Case "5": iColor = 7
Case "6": iColor = 8
Case "7": iColor = 9
Case "8": iColor = 10
Case "9": iColor = 11
Case "10": iColor = 12
Case "11": iColor = 13
Case "12": iColor = 14
Case "13": iColor = 15
Case "14": iColor = 16
Case "15": iColor = 17
End Select
actCell.Interior.ColorIndex = iColor
Range(Cells(actCell.Row, 4), Cells(actCell.Row, 6)).Interior.ColorIndex = iColor
End If
Next
hell:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set Bereich1 = Selection
End Sub
Nicht wundern, ich hab bei der Gelegenheit die "Case select" Sektion etwas aufgeräumt.
Das Worksheetfunction.average ist ein dreckiger Trick. Wenn nur gleiche Zahlen im Bereich stehen dürfen, ist der Mittelwert immer gleich der erlaubten Zahl. Geht kürzer, als jede Zelle im Bereich einzeln zu prüfen.
Genauso bei Worksheetfunction.sum - statt den Bereich Zellenweise auf leere zu überprüfen, schaue ich einfach ob die Summer des Bereichs null ist (das kommt nur bei einem leeren Bereich vor).
Range(Cells(actCell.Row, Bereich2.Column), Cells(actCell.Row, Bereich2.Columns.Count)
ist vielleicht etwas sperrig geschrieben, hat aber den Charme dass sich die Prüfung immer auf die Spalten des oben definierten "Bereich2" beziehen. Das heisst, wenn sich mal was ändert musst du nur an einer Stelle im Code den Bereich aktualisieren, und nicht in jeder Formel einzeln.
Grüße,
Klaus M.vdT.

Anzeige
AW: Formatierung durch Inhalt einer anderen zelle
11.01.2013 12:53:38
Hugo
Hallo Klaus,
ich habe es in meine Arbeitsmappe eingebaut, aber es funktioniert nicht.Siehe Datei: https://www.herber.de/bbs/user/83361.xls
Was mach ich falsch?
Danke für die Hilfe

AW: Formatierung durch Inhalt einer anderen zelle
14.01.2013 08:38:52
Klaus
Hi,
erstmal hast du einen generellen Fehler gemacht:

Private Sub Workbook_Open()
Worksheets("Alpine").Protect Password:="Dein Kennwort", UserInterfaceOnly:=True
Worksheets("Life").Protect Password:="Dein Kennwort", UserInterfaceOnly:=True
Worksheets("Fashion").Protect Password:="Dein Kennwort", UserInterfaceOnly:=True
Worksheets("Outlet").Protect Password:="Dein Kennwort", UserInterfaceOnly:=True
Worksheets("Kastelruth").Protect Password:="Dein Kennwort", UserInterfaceOnly:=True
Worksheets("Seis").Protect Password:="Dein Kennwort", UserInterfaceOnly:=True
Worksheets("Wolkenstein").Protect Password:="Dein Kennwort", UserInterfaceOnly:=True
End Sub
Option Explicit
Dim Bereich1 As Range
Private Sub Worksheet_Change(ByVal Target As Range)
Option Explicit
muss immer ganz oben im Modul stehen!
Davon abgesehen ist der ganze Code hier an der falschen Stelle. 

Code: Diese Arbeitsmappe
Private Sub Worksheet_Change(ByVal Target As Range)
Das Worksheet-Change Ereigniss hat in "Diese Arbeitsmappe nichts verloren. Kopiere den gesamten Code in die Klassenmodule der Tabellen!
(rechtsclick auf "Alpine"-Tabellenreiter, Code anzeigen, Code einfügen)
(rechtsclick auf "Life"-Tabellenreiter, Code anzeigen, Code einfügen)
(wiederholen für alle Tabellen)
Achte dabei darauf, dass der Code jeweils vollständig, auch mit ausgelageren Dimensionierungen, vorhanden ist.
Um es einfacher zu machen:
in "Diese Arbeitsmappe" steht insgesamt folgendes: 
Option Explicit
Private Sub Workbook_Open()
Worksheets("Alpine").Protect Password:="Dein Kennwort", UserInterfaceOnly:=True
Worksheets("Life").Protect Password:="Dein Kennwort", UserInterfaceOnly:=True
Worksheets("Fashion").Protect Password:="Dein Kennwort", UserInterfaceOnly:=True
Worksheets("Outlet").Protect Password:="Dein Kennwort", UserInterfaceOnly:=True
Worksheets("Kastelruth").Protect Password:="Dein Kennwort", UserInterfaceOnly:=True
Worksheets("Seis").Protect Password:="Dein Kennwort", UserInterfaceOnly:=True
Worksheets("Wolkenstein").Protect Password:="Dein Kennwort", UserInterfaceOnly:=True
End Sub
Im Tabellen-Modul von "Alpine", "Life", "usw..." steht insgesamt folgendes: 
Option Explicit
Dim Bereich1 As Range
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo hell  'Bei Fehler events wieder anschalten!
Dim actCell As Range
Dim Bereich2 As Range
Dim iColor As Integer
Set Bereich2 = Range("G4:AA52")
Application.ScreenUpdating = False
For Each actCell In Bereich1
If Not Intersect(actCell, Bereich2) Is Nothing Then
'prüfen, ob bereich leer bzw ob zahl zulässig
If Application.WorksheetFunction.Sum(Range(Cells(actCell.Row, Bereich2.Column), Cells(  _
_
actCell.Row, Bereich2.Columns.Count))) - actCell.Value = 0 Then
'erster eintrag, immer zulassen
Else
'wenn der Beitrag gleich einem anderem Beitrag im Bereich ist, dann
If actCell.Value = Application.WorksheetFunction.Average(Range(Cells(actCell.Row, _
Bereich2.Column), Cells(actCell.Row, Bereich2.Columns.Count))) Then
'nix, zulassen
Else
'verhindern
MsgBox ("Eintrag ungültig!")
Application.EnableEvents = False
actCell.Value = ""
actCell.Select
Application.EnableEvents = True
'Eintrag zu löschen löst erneut das "change" Ereigniss aus
'Events kurz abschalten, um das zu verhindern!
End If
End If
'aktive Zelle und 3 Zellen links einfärben
Select Case actCell
Case "": iColor = 2
Case "1": iColor = 3
Case "2": iColor = 4
Case "3": iColor = 5
Case "4": iColor = 6
Case "5": iColor = 7
Case "6": iColor = 8
Case "7": iColor = 9
Case "8": iColor = 10
Case "9": iColor = 11
Case "10": iColor = 12
Case "11": iColor = 13
Case "12": iColor = 14
Case "13": iColor = 15
Case "14": iColor = 16
Case "15": iColor = 17
End Select
actCell.Interior.ColorIndex = iColor
Range(Cells(actCell.Row, 3), Cells(actCell.Row, 5)).Interior.ColorIndex = iColor
End If
Next
hell:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set Bereich1 = Selection
End Sub
Übrigens:
Deine jetzt hochgeladene Datei stimmt im Tabellenaufbau nicht mit deiner vorher hochgeladenen Musterdatei überein. Ich habe mal den Code korrigiert, aus
Range(Cells(actCell.Row, 4), Cells(actCell.Row, 6)).Interior.ColorIndex = iColor
wurde
Range(Cells(actCell.Row, 3), Cells(actCell.Row, 5)).Interior.ColorIndex = iColor
und dann passt es auch auf deine Tabelle.
Grüße,
Klaus M.vdT.

Anzeige
AW: Formatierung durch Inhalt einer anderen zelle
14.01.2013 14:02:53
Hugo
Hallo Klaus,
super, es funktioniert einwandfrei. Bin Dir für Deine Hilfe unendlich dankbar!
Schöne Grüße aus Italiene
Huffi

Danke für die Rückmeldung!
14.01.2013 14:05:31
Klaus
und schöne Grüße zurück aus Estland!

378 Forumthreads zu ähnlichen Themen

Zellen mit Werten aus darüberliegender Zelle fülle
Andreas

Guten Morgen!
Ich hätte folgendes Problem: Ich erhalte automatisiert Exceltabellen, bei denen nicht alle Zellen einer Zeile gefüllt werden, wenn dort der Inhalt einer darüberliegenden Zeile stehen sollte. Zur Weiterverarbeitung muss ich aber diese Zellen mit den dazugehörigen Werten füllen....
11.08.2008 08:59:25
Thread-ID: 1000713
4 Beiträge
Anzeige
x ersetzen durch wert aus bestimmter zelle
Ingolf

hallo,
ich muß eine liste erstellen. die werte unten will ich nicht immer eingeben müssen, sondern nur dort wo ein wert stehen soll ein x machen. excel soll mir dann für jedes x den wert aus der zeile 2 der gleichen spalte eintragen. mache ich in eine zelle 2 x, dann muß der wert auch 2 mal...
22.08.2008 09:08:22
Thread-ID: 1003727
5 Beiträge
Inhalt einer Zelle im Windows Infobereich anzeigen
Thomas

Hallo,
kann ich den Inhalt einer Zelle im Windows Infobereich anzeigen lassen?
Ich habe eine VBA-Anwendung, die mir den Verarbeitungsstatus in einer Zelle anzeigt.
Weil die Verarbeitung sehr lange dauert möchte ich zwischendurch mit anderen Anwendungen arbeiten und unten rechts nebe...
27.08.2008 17:50:23
Thread-ID: 1005163
3 Beiträge
Anzeige
Wenn Wert weniger, in anderer Zelle um d.Wert erh.
Josef

Guten Morgen!
Ich habe z.B. in der Zelle A1 den Wert 5 stehen. Wird dieser Wert z.B. um die Zahl 3 verringert, dann soll der vorhandene Wert in der Zelle B1 um die Zahl 3 erhöht werden. Wie würde hier bitte eine Formellösung dafür lauten?
Danke
Josef
09.09.2008 05:49:00
Thread-ID: 1008272
2 Beiträge
Bestimmte Werte aus einer Zelle herausfiltern
G_G

Hallo zusammen.
Ich habe in einer Zelle einen etwas längeren Text (mit Zahlen und Buchstaben). Ich würde jetzt gerne hieraus den Wert rausfiltern (in separate Spalte), der neben der Buchstabenkombination "AT" steht.
Hört sich einfach an. Da gibt es aber noch einige Sonderfälle.
Ich...
15.09.2008 12:03:00
Thread-ID: 1009747
5 Beiträge
Bestimmten Wert in einer Zelle finden
Olli

Hallo,
ich lauf gerade wieder mal mit einem Brett vorm Kopf rum und hoffe, mir kann einer hier helfen.
Ich habe in einer Zelle mehrere Werte stehen, die jeweils durch Semikolon getrennt sind (bis zu 15).
Wie kann ich per VBA eine Schleife erstellen, dass solange nach einem Wert gesu...
19.09.2008 08:54:00
Thread-ID: 1010897
5 Beiträge
Textinhalte aus Zellen zusammenkopieren
zehetner

Liebe Profis,
ich habe die Ergebnisse einer Befragung in ein Excel-Sheet eingegeben, jeder Befragte in ein Registerblatt. Nun möchte ich die Antworten der Befragten, die in Textfeldern (immer in den selben, zB E145 stehen) gesammelt in eine neue Tabelle bringen.
Ziel ist es, die Antwort...
21.09.2008 18:29:25
Thread-ID: 1011343
2 Beiträge
Wert aus Zelle holen für VBA
Oliver

Hallo eine kleine Frage,
wollte folgendes umsetzen, ein Benutzer fügt in der Excelobelfläche im ersten Blatt eine Zahl ein. Diese soll jetzt wie folgt verwendet werden:
falls ... größer als dem Zellinhalt, dann ...
meine Idee:
Dim Wert As Integer
Wert = cells(20, 2)
If.....
25.09.2008 10:06:31
Thread-ID: 1012241
6 Beiträge
Anzeige

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge
3
16
4
2
5
1
4
4
1
5
30
4
8
3
2
5
2
4
4
2
9
5
5
9
8