Office: (Office 2010) Makro Modifizierung

Hallo Leute,

ich brauch mal wieder Eure Hilfe. Ich will folgendes funktionierendes Makro erweitern.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B2:B540, G2:G540, I2:I540, K2:K540, M2:M540, O2:O540, Q2:Q540")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen
If Target = "" Then
Target.Offset(0, 1).ClearContents
Else:
Target.Offset(0, 1) = Date$
End If
Dim rngZelle As Range
If Target.Cells(1).Value = "x" Then
Application.EnableEvents = False
For Each rngZelle In Target
rngZelle.Value = "abgeschlossen"
rngZelle.Interior.ColorIndex = 4
Target.Font.ColorIndex = 1
Cells(rngZelle.Row, 1).Interior.ColorIndex = 4
Next rngZelle
Application.EnableEvents = True
End If
If Target.Cells(1).Value = "w" Then
Application.EnableEvents = False
For Each rngZelle In Target
rngZelle.Value = ""
rngZelle.Interior.ColorIndex = 2
Target.Font.ColorIndex = 1
Cells(rngZelle.Row, 1).Interior.ColorIndex = 2
Next rngZelle
Application.EnableEvents = True
End If

End Sub



Und zwar soll folgende Funktion: Cells(rngZelle.Row, 1).Interior.ColorIndex = 4 nur eintreten wenn in der Zeile die Spalte B und eine der anderen Spalten mit einem X als abgeschlossen gekennzeichnet wurden. Also in jeder Spalte für sich bleibt es bei der Veränderung durch ein X. Nur soll die erste Spalte nur Grün werden wenn in zwei Spalten (B und einer anderen) ein x steht.
Ich hoffe das ist einigermaßen verständlich und ich bitte um eure Hilfe.

Vielen Dank schon mal für Eure Bemühungen.

 

Hi,

weshalb benutzt du nicht die bedingte Formatierung anstelle VBA?

Ersetzt deine Zeile Cells(rngZelle.Row, 1).Interior.ColorIndex = 4 durch diesen Code:

Code:

    Dim rngBereich As Range
    Dim rngZelle As Range
    Dim intZaehler As Integer
    Set rngBereich = Union(Cells(Target.Row, 7), Cells(Target.Row, 9), Cells(Target.Row, 11), Cells(Target.Row, 13), Cells(Target.Row, 15), Cells(Target.Row, 17))
    If Cells(Target.Row, 2) = "x" Then
        For Each rngZelle In rngBereich
            If rngZelle.Value = "x" Then intZaehler = intZaehler + 1
        Next rngZelle
        If intZaehler > 0 Then Cells(Target.Row, 1).Interior.ColorIndex = 4
    End If

Bis später,
Karin

Bis später,
Karin

 

Hallo Karin,

vielen Dank für deine Bemühungen und deine Hilfe. Leider funktioniert es bei mir nicht. Wenn ich deinen Code für die Zeile einsetze meckert Excel über eine Doppeltnennung von "Dim rngBereich as Range" und wenn ich es dann einmal streiche passiert nichts mehr in meinem Code.

Viele Grüße
Jonas

 

Hi Jonas,

da dein Code (im Gegensatz zu meinem) unstrukturiert und deshalb unleserlich und damit schwer verständlich ist, habe ich übersehen, dass du bereits eine Variable rngZelle (nicht rngBereich!!!) benutzt - ändere in meinem Code rngZelle in rngZelle2.
Außerdem solltest du generell alle Variablendeklarationen (also auch meine) an den Anfang der Prozedur stellen - dann wäre diese Doppelbenennung gleich ins Auge gefallen...

Ich habe mir jetzt mal die Mühe gemacht, deinen Code in eine Beispielmappe einzufügen und zu testen - bei dir wird ein eingetragenes "x" in das Wort "abgeschlossen" umgewandelt, also ist deine Aussage:

wenn in der Zeile die Spalte B und eine der anderen Spalten mit einem X als abgeschlossen gekennzeichnet wurden.

falsch, denn nicht "x" steht in der Zelle sondern "abgeschlossen". Es darf also nicht nach "x" gesucht werden sondern du musst in meinem Code "x" durch "abgeschlossen" ersetzen.

Bis später,
Karin

 

Hallo Karin,

ich bin dir sehr dankbar für deine Hilfe, da ich in diesem Thema nicht so fit bin. Ich habe diesen Code auch mit Hilfe des Forums entwickelt und bin froh, dass er so funktioniert hat.
Ich habe nun alles versucht so zu ändern, wie du gesagt hast und bekomme nun leider die Fehlermeldung "For-Steuervariable" wird bereits verwendet.

VG
Jonas

 

Hallo Karin,

vielen Dank ich habe nun eine Sache nun geändert und nun funktioniert es auch bei mir. Vielen vielen Dank für deine Hilfe.

Viele Grüße
Jonas

 

Hi Jonas,

ich nehme an, du hattest in der Zeile Next rngZelle2 in meinem Code die 2 vergessen zu ergänzen?

Bis später,
Karin

 

Genau :)

 

Nur ein Hinweis für die Zukunft: wenn man etwas ändert, das dann zur Lösung eines Problems führt, sollte man hier auch posten WAS man geändert hat, damit andere User ebenfalls davon profitieren können. ;)

Bis später,
Karin

 

Hallo Karin, Hallo Freunde,

vielleicht kann mir einer bei einer kleinen Modifikation helfen. Die erste Spalte soll nur grün werden wenn in Spalte B "abgeschlossen erscheint UND in Spalte H/J/L/N/P/R ein zweites "abgeschlossen" erscheint. Momentan ist mir aufgefallen wird Spalte A auch grün wenn nur Spalte B "abgeschlossen" ist.

Der Einfachheithalber hier nochmal der aktuelle Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B2:B540, H2:H540, J2:J540, L2:L540, N2:N540, P2:P540, R2:R540")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen
If Target = "" Then
Target.Offset(0, 1).ClearContents
Else:
Target.Offset(0, 1) = Date$
End If
Dim rngZelle As Range

If Target.Cells(1).Value = "x" Then
Application.EnableEvents = False
For Each rngZelle In Target
rngZelle.Value = "abgeschlossen"
rngZelle.Interior.ColorIndex = 4
Target.Font.ColorIndex = 1
Dim rngBereich As Range
Dim rngZelle2 As Range
Dim intZaehler As Integer
Set rngBereich = Union(Cells(Target.Row, 2), Cells(Target.Row, 8), Cells(Target.Row, 10), Cells(Target.Row, 12), Cells(Target.Row, 14), Cells(Target.Row, 16), Cells(Target.Row, 18))
If Cells(Target.Row, 2) = "abgeschlossen" Then
For Each rngZelle2 In rngBereich
If rngZelle.Value = "abgeschlossen" Then intZaehler = intZaehler + 1
Next rngZelle2
If intZaehler > 0 Then Cells(Target.Row, 1).Interior.ColorIndex = 4
End If
Next rngZelle
Application.EnableEvents = True
End If
If Target.Cells(1).Value = "w" Then
Application.EnableEvents = False
For Each rngZelle In Target
rngZelle.Value = ""
rngZelle.Interior.ColorIndex = 2
Target.Font.ColorIndex = 1
Cells(rngZelle.Row, 1).Interior.ColorIndex = 2
Next rngZelle
Application.EnableEvents = True
End If

End Sub


Ich habe es probiert aber finde selber einfach keine Lösung. Wäre super wenn einer mir helfen kann. Vielen Dank an Euch

 

Ist ja auch kein Wunder, denn du hast die Zeilen

Code:

[TABLE="width: 88"]
<tbody>[TR]
[TD="width: 88"]rngZelle.Value =   "abgeschlossen"[/TD]
[/TR]
[TR]
[TD]rngZelle.Interior.ColorIndex = 4[/TD]
[/TR]
</tbody>[/TABLE]

mit denen das "x" durch "abgeschlossen" ersetzt und anschlließend die Zelle grün gefärbt wird - also auch wenn du in Spalte A etwas einträgst. Entweder du lässt die 2. Zeile ganz weg, falls die Farbe nicht auch in den Spalten B, H, J usw. geändert werden soll, denn Spalte A wird ja in dem von mir geposteten Code gefärbt, falls noch in einer anderen Spalte "abgeschlossen" steht. Oder falls auch in den anderen Spalte gefärbt werden soll, dann schreibst du stattdessen:

Code:

If rngZelle.Column <> 1 Then rngZelle.Interior.ColorIndex = 4

Es wird also geprüft ob rngZelle in Spalte A ausgeführt wird und die Farbe wird nur gesetzt falls nicht Spalte A.

Bis später,
Karin

 

Hallo Karin,

In Spalte A wird nie etwas manuell eingetragen. Diese Spalte (bzw. eine Zelle) soll nur grün werden wenn in einer Zeile zweimal abgeschlossen erscheint. Also ich setze z.B. in Zeile 1 in Spalte B und in Spalte H ein abgeschlossen. Erst dann soll die Zelle in Spalte A grün werden. Nur ein abgeschlossen in Spalte B soll nicht dazu führen, dass Spalte A grün wird.

Viele Grüße
Jonas

 

Hi Jonas,

dann so:

Code:

    Dim rngBereich As Range
    Dim rngZelle As Range
    Dim intZaehler As Integer
    Set rngBereich = Union(Cells(Target.Row, 2), Cells(Target.Row, 8), Cells(Target.Row, 10), Cells(Target.Row, 12), Cells(Target.Row, 14), Cells(Target.Row, 16), Cells(Target.Row, 18))
    For Each rngZelle In rngBereich
        If rngZelle = "abgeschlossen" Then intZaehler = intZaehler + 1
        If intZaehler = 2 Then
            Cells(Target.Row, 1).Interior.ColorIndex = 4
            Exit For
        End If
    Next rngZelle

Bis später,
Karin

 

Hallo Karin,

ich probiere die ganze Zeit es einzubinden und verstehe sogar die Logik des Codes :) aber ich kriege es dennoch nicht zum laufen.

So schaut der gesamte Code nun aus. Aber momentan passiert bei einem "X" gar nichts mehr....

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B2:B540, H2:H540, J2:J540, L2:L540, N2:N540, P2:P540, R2:R540")) Is Nothing Then Exit Sub
If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen
If Target = "" Then
Target.Offset(0, 1).ClearContents
Else:
Target.Offset(0, 1) = Date$
End If
Dim rngZelle As Range

If Target.Cells(1).Value = "x" Then
Application.EnableEvents = False
For Each rngZelle In Target
rngZelle.Value = "abgeschlossen"
rngZelle.Interior.ColorIndex = 4
Target.Font.ColorIndex = 1
Dim rngBereich As Range
Dim intZaehler As Integer
Set rngBereich = Union(Cells(Target.Row, 8), Cells(Target.Row, 10), Cells(Target.Row, 12), Cells(Target.Row, 14), Cells(Target.Row, 16), Cells(Target.Row, 18))
For Each rngZelle In rngBereich
If rngZelle = "abgeschlossen" Then intZaehler = intZaehler + 1
If intZaehler = 2 Then
Cells(Target.Row, 1).Interior.ColorIndex = 4
Exit For
End If
Next rngZelle
Application.EnableEvents = True
End If
If Target.Cells(1).Value = "w" Then
Application.EnableEvents = False
For Each rngZelle In Target
rngZelle.Value = ""
rngZelle.Interior.ColorIndex = 2
Target.Font.ColorIndex = 1
Cells(rngZelle.Row, 1).Interior.ColorIndex = 2
Next rngZelle
Application.EnableEvents = True
End If

End Sub


Bis Später
Jonas

 

Hi Jonas,

ich würde denken so, kann es jedoch nicht testen da ich 1. deine Mappe nicht kenne und mir 2. auch nicht klar ist, was bei dir wann genau pasieren soll

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngZelle As Range
    Dim rngBereich As Range
    Dim intZaehler As Integer
    If Intersect(Target, Range("B2:B540, H2:H540, J2:J540, L2:L540, N2:N540, P2:P540, R2:R540")) Is Nothing Then Exit Sub
    If Target.Count > 1 Then Exit Sub 'Bearbeiten mehrerer Zeilen wird abgefangen
    If Target = "" Then
        Target.Offset(0, 1).ClearContents
    Else:
        Target.Offset(0, 1) = Date$
    End If
    Set rngBereich = Union(Cells(Target.Row, 2), Cells(Target.Row, 8), Cells(Target.Row, 10), Cells(Target.Row, 12), Cells(Target.Row, 14), Cells(Target.Row, 16), Cells(Target.Row, 18))
    If Target.Cells(1).Value = "x" Then
        Application.EnableEvents = False
        For Each rngZelle In Target
            rngZelle.Value = "abgeschlossen"
        Next rngZelle
        For Each rngZelle In rngBereich
            If rngZelle = "abgeschlossen" Then intZaehler = intZaehler + 1
            If intZaehler = 2 Then
                Cells(Target.Row, 1).Interior.ColorIndex = 4
                Exit For
            End If
        Next rngZelle
        Application.EnableEvents = True
    ElseIf Target.Cells(1).Value = "w" Then
        Application.EnableEvents = False
        Target.Value = ""
        Target.Interior.ColorIndex = 2
        Target.Font.ColorIndex = 1
        Cells(Target.Row, 1).Interior.ColorIndex = 2
        Application.EnableEvents = True
    End If
End Sub

Soll die Farbe tatsächlich auf Weiß gesetzt werden oder soll sie einfach zurückgesetzt werden auf keine Farbe wenn "w" eingegeben wird? Falls die Farbe zurück auf keine Farbe gesetzt werden soll, dann musst du anstelle = 2 schreiben = xlNone

Bis später,
Karin