---

Geb.jpg

Geb.jpg


Hallo zusammen,
folgendes Problem:

In einer Exceldatei/Tabellenblatt müssen Werte geprüft werden, alle Zellen, ausser der Überschrift (es sind meist die ersten drei Zeilen).
Sind Zellen befüllt soll sich in der letzte Zelle der Reihe ein Ok mit farblicher Grünen hinterlegung abbilden.

Hat die Zellen keinen Wert/(Text usw.) soll die letzte Zelle der Reihe (nicht gefüllte Zelle) eine farbliche Hinterlegung rot und Text prüfen bekommen.

Siehe Anhang.

Vorab vielen Dank
für die VBA Unterstützung

Toppas

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo Toppas,

wenn ich Dich recht verstanden habe, suchst Du folgendes:

Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim i As Integer
    Dim j As Integer
    Dim maxj As Integer
    For i = 1 To XXX 'Zeile, noch setzen
        For j = 1 To maxj 'Spalte, noch setzen
            If Cells(i, j).Value <> "" Then
                GoTo weiter 'Sprungmarke für beschriebene Zelle: mit der nächsten Spalte fortfahren
            Else
                With Cells(i, maxj + 1)
                    .Value = "prüfen"
                    .Interior.ColorIndex = 3
                End With
                GoTo weiter_i 'Sprungmarke für fehlenden Eintrag: mit der nächsten Zeile fortfahren
            End If
            weiter:
        Next
        'sollten alle Spalten einer Zeile durchlaufen worden sein, gibt es keinen Fehler
        With Cells(i, maxj + 1)
            .Value = "OK"
            .Interior.ColorIndex = 4
        End With
weiter_i:
    Next
End Sub

Kopiere den Code einfach in Dein Tabellenblatt, das geändert werden soll und probiere es aus! Und bei Fragen, fragen.

okl

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Hallo,

hier mal ein klitzekleiner Ansatz:

Code:

---

Sub x()
    Dim i&
    For i = 4 To Cells(Rows.Count, 1).End(xlUp).Row
        If WorksheetFunction.CountA(Range(Cells(i, 1), Cells(i, 15))) = 15 Then
            Cells(i, 16).Interior.ColorIndex = 43
        Else
          Cells(i, 16).Interior.ColorIndex = 3
        End If
    Next
End Sub

---

Gruss Nancy

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

ok-pruefen.xls.txt

ohne Vba geht's 'türlich auch

Code:

---

=IF(COUNTBLANK(A8: O8)=0;"OK";"prüfen")

---

und den Zellen eine bedingte Formatierung zuweisen

habe gerade kein deutsches XL zur hand - deshalb Bspmappe
IF = WENN()
COUNTBLANK = ANZAHLLEEREZELLEN()[thedit]nun im d. Excel nachgeschaut  & dank an RunkelRübe für Übersetzung per PM  [theditoff]

*arghs* ich hasse die Zellenangabe doppelpunktO ...  

[Diese Nachricht wurde von Thomas Harmening am 12. Jun. 2006 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP