Suchen, Auswählen, Merken, Drucken

[Alex105]

Hallo Schauan,

ah so aber G wird ja automatisch ermittelt, wenn "select Timeline" ausgesucht wird :19:

Die Zelle "G" wird auch für Eingaben gesperrt. Der Kunde kann zukünftlich "nur" "I" & "K" auswählen.

Übrigens, deine Farbauswahl gefällt mir sehr gut das ganze jetzt nur noch für die gesamte Zeile und es wäre auf dem Weg perfekt zu werden

Vielen Dank und viele sonnige Grüße
Alex

[schauan]

Hallo Alex,

bei der Spalte 7 war ich noch in der Mustertabelle. Ich würde dann also die 9 nehmen?
Folgende Änderungen nimmst Du in Deine Exceldatei:
In DieseArbeitsmapppe, Makro SheetChange

Code:

'Wenn die Aenderung in Spalte G erfolgt und nur eine Spalte betrifft, dann
       If Target.Row > 2 And Target.Column = 9 And Target.Columns.Count = 1 Then
         For Each zellen In Target
           'Wenn Inhalt > 0 ist, dann mit ... einfaerben, sonst Farbe rausnehmen
           If Target > 0 Then Target.EntireRow.Interior.Color = 5296274 Else Target.EntireRow.Interior.Color = xlNone

Ich habe jetzt noch die Zeile >2 genommen, weil sonst in dem temporären Blatt bei Eintrag des users in Zeile 2 selbige auch grün wird. Wenn jemand was auf dem "kopierten" Tabellenblatt in Spalte I schreibt, wird die Farbe nämlich auch dort gesetzt. 3 Zeilen drunter steht dann zusätzlich 2x .EntireRow.

Im Makro kopieren hab ich die Zeile zum Farben rausnehmen geändert. Wenn hier die Zeilennummern nicht passen, bitte ändern. Bei der Endzeile bitte genug Reserve für weitere Einträge einplanen.

Code:

'Farben rausnehmen
Rows("19:3000").Interior.Color = xlNone '<-- hier Startzeile und eventuell Endzeile anpassen

Im Reset ist es ähnlich, nur dass hier schon in Zeile 3 begonnen wird.

Code:

'Farben rausnehmen                              '<-- hier
    blaetter.Rows("3:3000").Interior.Color = xlNone     '<-- hier

Das funktioniert übrigens nur bei Eingabe. Die Auswahl in Spalte K löst keine Aktion aus.

[Alex105]

Hallo Schauan,

vielen Dank für Deine super Hilfe

Bevor ich es jetzt einkopiere vielleicht zur Sicherheit nochmal die Frage mal angenommen, jemand such in select Timeline eine Zeit aus. Wenn ich deinen Code bzw. Deine Kommentare richtig interpretiere, passiert dann nichts, weil der Wert in "G" "nur" die Färbung vornimmt, wenn diese händisch eingetragen wird?

Vielen Dank und viele Grüße
Alex

PS: Bekommen wir das mit dem Kopieren auch mit gesperrten Zellen noch hin?! :15:

[schauan]

Hallo ALex,

fast richtig Ich hab ja aus der 7 eine 9 gemacht, also ist jetzt Spalte I mit der benötigten Anzahl die ausschlaggebende Spalte.

Hilf mir nochmal auf die Sprünge mit gesperrten Zellen. Wann und wo passiert das? Eine Kopie aus einer gesperrten Zelle sollte z.B. funktionieren, es sei denn , die ist auch zur Auswahl gesperrt.
Ohne Codeänderung wäre das Kopieren möglich, wenn Du beim Blattschutz die Auswahl gesperrter Zellen zulässt.

Ansonsten im Makro Kopieren diese Zeilen einfügen (ungetestet)

Code:

'mit dem Blatt myWsh
  With myWsh
    'Wenn der Blattname vom temporaeren Blatt <> vom Blatt myWsh ist, dann
    If tmpWsh.Name <> myWsh.Name And myWsh.Name <> "Input" Then
        'Zugriff auf gesperrte Zellen erlauben          '<-- hier
        .EnableSelection = xlNoRestrictions  '<-- hier

und hier

Code:

'Ende Wenn die Summe von Spalte G > 0 ist, dann
        End If
        'Zugriff auf gesperrte Zellen verweigern        '<-- hier
        .EnableSelection = xlUnlockedCells   '<-- hier
    'Ende Wenn der Blattname vom temporaeren Blatt <> vom Blatt myWsh ist, dann
    End If

Es könnte aber jetzt auch beim Einfärben der ganzen Zeile oder auch beim Entfärben klemmen...

[Alex105]

Hallo Schauan,

oh man, ist vielleicht auch heute nicht ganz mein Tag

Genau: ich werde alles sperren was geht außer außer "I" und "K". Bisher habe ich die beiden zellen "nicht gesperrt" und den Rest schon. Darauf hin kam dann immer diese Fehlermeldung, die ich dir mal gepostet habe :)

Wäre es möglich, dass er die Zellen nur bis "M" einfärbt? Ich hab da glaube ich mist gebaut beim kopieren, weil jetzt ein Fehler kommt :( "Laufzeitfehler 424" 'Objekt erforderlich'

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    'Wenn der Name des aktiven Blattes <> Input und Sales ist, dann
    If Sh.Name <> "Input" And Sh.Name <> "Sales" Then
       'Wenn die Aenderung in Spalte G erfolgt und nur eine Spalte betrifft, dann
       If Target.Row > 2 And Target.Column = 9 And Target.Columns.Count = 1 Then
         For Each zellen In Target
           'Wenn Inhalt > 0 ist, dann mit ... einfaerben, sonst Farbe rausnehmen
           If Target > 0 Then Target.EntireRow.Interior.Color = 5296274 Else Target.EntireRow.Interior.Color = xlNone <--HIER
         'Ende Schleife ueber alle gewaehlten Zellen
         Next
      'Ende Wenn die Aenderung in Spalte G erfolgt und nur eine Spalte betrifft, dann
       End If
    'Ende Wenn der Name des aktiven Blattes <> Input und Sales ist, dann
    End If
End Sub

Vielleicht sollte man sich auch nicht mit Kopfschmerzen daran setzten

Hab ich mich eigentlich schon bei dir bedankt?!

Danke :100:
Alex

[Alex105]

Hallo Schauan,

nach etwas mehr Konzentration hier das vorläufige Ergebnis

Es läuft "eigentlich" alles einwandfrei.

ABER:

Beim Einfügen des letzten Codes

"Im Reset ist es ähnlich, nur dass hier schon in Zeile 3 begonnen wird."

Code:

'Farben rausnehmen                              '<-- hier
    blaetter.Rows("3:3000").Interior.Color = xlNone     '<-- hier

Kommt ein Fehler:

"Laufzeitfehler 13" 'Typen unverträglich'

ich glaube sonst würde es gehen

Viele Grüße und vielen Dank
Alex

[Alex105]

Edit: Der Laufzeitfehler kommt hier:

Code:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    'Wenn der Name des aktiven Blattes <> Input und Sales ist, dann
    If Sh.Name <> "Input" And Sh.Name <> "Sales" Then
'Wenn die Aenderung in Spalte I erfolgt und nur eine Spalte betrifft, dann
       If Target.Row > 2 And Target.Column = 9 And Target.Columns.Count = 1 Then
         For Each zellen In Target
           'Wenn Inhalt > 0 ist, dann mit ... einfaerben, sonst Farbe rausnehmen
           If Target > 0 Then Target.EntireRow.Interior.Color = 5296274 Else Target.EntireRow.Interior.Color = xlNone <----HIER
         'Ende Schleife ueber alle gewaehlten Zellen
         Next
      'Ende Wenn die Aenderung in Spalte G erfolgt und nur eine Spalte betrifft, dann
       End If
    'Ende Wenn der Name des aktiven Blattes <> Input und Sales ist, dann
    End If
End SubPrivate Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    'Wenn der Name des aktiven Blattes <> Input und Sales ist, dann
    If Sh.Name <> "Input" And Sh.Name <> "Sales" Then
'Wenn die Aenderung in Spalte I erfolgt und nur eine Spalte betrifft, dann
       If Target.Row > 2 And Target.Column = 9 And Target.Columns.Count = 1 Then
         For Each zellen In Target
           'Wenn Inhalt > 0 ist, dann mit ... einfaerben, sonst Farbe rausnehmen
           If Target > 0 Then Target.EntireRow.Interior.Color = 5296274 Else Target.EntireRow.Interior.Color = xlNone
         'Ende Schleife ueber alle gewaehlten Zellen
         Next
      'Ende Wenn die Aenderung in Spalte G erfolgt und nur eine Spalte betrifft, dann
       End If
    'Ende Wenn der Name des aktiven Blattes <> Input und Sales ist, dann
    End If
End Sub

:91:


Gruß
Alex

[schauan]

Hallo ALex,

noch einige Änderungen:

In DieseArbeitsmappe, ...SheetChange ...
habe ich die eine If-Prüfung um die Areas erweitert und weiter unten aus Target>0 zellen>0 gemacht.

Code:

'Wenn die Aenderung in Spalte G erfolgt und nur eine Spalte betrifft, dann
       If Target.Row > 2 And Target.Column = 9 And Target.Columns.Count = 1 And Target.Areas.Count = 1 Then '<-- hier
         'Schleife ueber alle gewaehlten Zellen
         For Each zellen In Target
           'Wenn Inhalt > 0 ist, dann mit ... einfaerben, sonst Farbe rausnehmen
           If zellen > 0 Then Target.EntireRow.Interior.Color = 5296274 Else Target.EntireRow.Interior.Color = xlNone '<-- hier
         'Ende Schleife ueber alle gewaehlten Zellen
         Next

Im cellReset habe ich zwei Zeilen zusammengefasst, die zweite muss gelöscht werden:

Code:

'Spalte I und K ab Zeile 3 bereinigen
    blaetter.Range("I3:I1048576,K3:K1048576").Value = "" '<-- hier ändern
    'blaetter.Range("K3:K1048576").Value = ""            '<-- hier Zeile löschen

[Alex105]

Hallo Schauan

ich glaube ja wirklich, dass du das Talent hättest Leute zu unterrichten

Vielen Dank. Es funktioniert. :19:

Hattest du evtl. nochmal Gelegenheit danach zu schauen, ob er die Zeilen nur bis "M" färben kann?

UND JETZT NOCH EINE BEICHTE :05:

Ich hatte zwischen einigen Artikeln -als eine Art Abgrenzung- Zeilen grau abgestuft. Irgendwie ist das jetzt nach "Reset" weg (also die Farbe in der Zeile). Diese Information hättest du gerne vorher gehabt oder? :17:

Entschuldigung, Schauan.

Lieben Dank,
Alex

[schauan]

Hallo ALex,

irgendwann hab ich den grauen Streifen auch schon mal gesehen, nur nicht für voll genommen ... Ich werde dann wohl doch eine Schleife bauen, die nur die Zeilen zurücksetzt, wo was drin steht. Wenn ich die Einträge einzeln rausnehme, greift das andere Makro ...SheetChange... und die Farbe geht auf den Datenblättern "automatisch" weg. Auf der Kopie passt es ja. Kommt aber dann morgen Abend. Ebenso die Spalte M