2 for each schleifen + Text in Zelle einfügen
04.04.2018 07:22:38
Alexander
vielleicht kann mir hier jemand helfen, ich komme da leider nicht weiter.
Folgendes Script ist vorhanden. Es wird überfrüft welcher Buchstabe in P8:P200 steht und färbt andere Zellen (links daneben) dafür passend ein.
Option Explicit Sub farbe() Dim rngCell As Range For Each rngCell In Range("P8:P200") Select Case rngCell Case "a" 'Wenn buchstabe b dann rngCell.Offset(0, -9).Interior.ColorIndex = 43 'Farbe für G setzen rngCell.Offset(0, -8).Interior.ColorIndex = 43 'Farbe für H setzen rngCell.Offset(0, -7).Interior.ColorIndex = 43 'Farbe für I setzen Case "y" 'Wenn buchstabe b dann rngCell.Offset(0, -9).Interior.ColorIndex = 43 'Farbe für G setzen rngCell.Offset(0, -8).Interior.ColorIndex = 45 'Farbe für H setzen rngCell.Offset(0, -7).Interior.ColorIndex = 43 'Farbe für I setzen Case "x" 'Wenn Buchstabe c dann rngCell.Offset(0, -9).Interior.ColorIndex = 45 'Farbe für G setzen rngCell.Offset(0, -8).Interior.ColorIndex = 43 'Farbe für H setzen rngCell.Offset(0, -7).Interior.ColorIndex = 43 'Farbe für I setzen Case "g" 'Wenn Buchstabe d dann rngCell.Offset(0, -9).Interior.ColorIndex = 22 'Farbe für G setzen rngCell.Offset(0, -8).Interior.ColorIndex = 22 'Farbe für H setzen rngCell.Offset(0, -7).Interior.ColorIndex = 22 'Farbe für I setzen Case "e" 'Wenn buchstabe e dann rngCell.Offset(0, -9).Interior.ColorIndex = 22 'Farbe für G setzen rngCell.Offset(0, -8).Interior.ColorIndex = 22 'Farbe für H setzen rngCell.Offset(0, -7).Interior.ColorIndex = 26 'Farbe für I setzen Case "z" 'Wenn Buchstabe z dann rngCell.Offset(0, -9).Interior.ColorIndex = 43 'Farbe für G setzen rngCell.Offset(0, -8).Interior.ColorIndex = 43 'Farbe für H setzen rngCell.Offset(0, -7).Interior.ColorIndex = 22 'Farbe für I setzen Case "zx" 'Wenn Buchstabe zx dann rngCell.Offset(0, -9).Interior.ColorIndex = 45 'Farbe für G setzen rngCell.Offset(0, -8).Interior.ColorIndex = 43 'Farbe für H setzen rngCell.Offset(0, -7).Interior.ColorIndex = 22 'Farbe für I setzen Case "zy" 'Wenn Buchstabe zy dann rngCell.Offset(0, -9).Interior.ColorIndex = 43 'Farbe für G setzen rngCell.Offset(0, -8).Interior.ColorIndex = 45 'Farbe für H setzen rngCell.Offset(0, -7).Interior.ColorIndex = 22 'Farbe für I setzen Case "kx" 'Wenn Buchstabe kx dann rngCell.Offset(0, -9).Interior.ColorIndex = 45 'Farbe für G setzen rngCell.Offset(0, -8).Interior.ColorIndex = 22 'Farbe für H setzen rngCell.Offset(0, -7).Interior.ColorIndex = 26 'Farbe für I setzen Case "ky" 'Wenn Buchstabe ky dann rngCell.Offset(0, -9).Interior.ColorIndex = 22 'Farbe für G setzen rngCell.Offset(0, -8).Interior.ColorIndex = 45 'Farbe für H setzen rngCell.Offset(0, -7).Interior.ColorIndex = 26 'Farbe für I setzen Case "l" 'Leerzeile rngCell.Offset(0, -1).Interior.ColorIndex = 16 'Farbe für O setzen rngCell.Offset(0, -2).Interior.ColorIndex = 16 'Farbe für N setzen rngCell.Offset(0, -3).Interior.ColorIndex = 16 'Farbe für M setzen rngCell.Offset(0, -4).Interior.ColorIndex = 16 'Farbe für l setzen rngCell.Offset(0, -5).Interior.ColorIndex = 16 'Farbe für k setzen rngCell.Offset(0, -6).Interior.ColorIndex = 16 'Farbe für J setzen rngCell.Offset(0, -7).Interior.ColorIndex = 16 'Farbe für I setzen rngCell.Offset(0, -8).Interior.ColorIndex = 16 'Farbe für H setzen rngCell.Offset(0, -9).Interior.ColorIndex = 16 'Farbe für G setzen rngCell.Offset(0, -10).Interior.ColorIndex = 16 'Farbe für F setzen rngCell.Offset(0, -11).Interior.ColorIndex = 16 'Farbe für E setzen rngCell.Offset(0, -12).Interior.ColorIndex = 16 'Farbe für D setzen rngCell.Offset(0, -13).Interior.ColorIndex = 16 'Farbe für C setzen rngCell.Offset(0, -14).Interior.ColorIndex = 16 'Farbe für B setzen rngCell.Offset(0, -15).Interior.ColorIndex = 16 'Farbe für A setzen Case "" 'Wenn Zelle leer dann rngCell.Offset(0, -9).Interior.ColorIndex = 2 'Farbe für G setzen rngCell.Offset(0, -8).Interior.ColorIndex = 2 'Farbe für H setzen rngCell.Offset(0, -7).Interior.ColorIndex = 2 'Farbe für I setzen End Select Next rngCell End Sub
Jetzt benötige ich noch eine weitere Schleife
For Each rngCell In Range("D8:D200")
Select Case rngCell
Case "Plattea"
rngCell.Offset(0, -9).Interior.Value = "Text-a"
Case "Platteb"
rngCell.Offset(0, -9).Interior.Value = "Text-b"
End Select
Next rngCell
Es soll überprüft werden ob in D8 - D200 das Wort Platte steht, wenn ja dann in das Feld rechts daneben Text eintragen.
Problem:
1. Ich kann keine zweite Schleife darunter schreiben, ich bekomme immer eine Fehlermeldung mit Haltemodus
2. Wie ich Farben ändern kann weiss ich ja, aber wie bekomme ich Text in die Felder? Mit Value? Hab leider gar keinen Plan und sitze schon ziemlich lange an der Sache.
Vielleicht kann mir da jemand auf die Sprünge helfen?
Danke und Gruß
Alex