Suchen, Auswählen, Merken, Drucken

[Alex105]

Hallo Schauan,

herzlichen Dank für deine Überarbeitung

Wenn wir Cell Reset nutzen, färbt er mir die grau hinterlegten Zellen wieder weiß ein.

Wäre es möglich, dass er die auf die von mir (oder dir) gewählte Graustufe zurück setzt?

Bezgl. des Blattschutzes. Im wesentlichen geht es mir darum, dass der Kunde keine Eingaben machen kann außer im "Input" und in den Tabellenblättern "I" und "K". Wenn dir eine bessere Idee einfällt, wie man den Inhalt schützen kann (und keine Formeln sieht), gerne

Viele sonnige Grüße und danke
Alex

[schauan]

Hallo Alex,
Hast Du den ganzen code von...sheetchange.. übernommen? Bei mir lief es damit. Ich teste es noch mal.

[Alex105]

Hallo Schauan,

nach dem Einfügen deines Codes mit anschließendem Test kommt beim Auswählen des Kopierens folgender Fehler:

"Laufzeitfehler" '1004':
Die NumberFormat-Eigentschaft des Range-Objektes kann nicht festgelegt werden

Debuggen =

Code:

.Offset(0, -1).Value = "approx. total amount"
  'Euroformat
  .NumberFormat = "#,##0.00 $" <-- HIER
  'Fett
  .Font.Bold = True

[schauan]

Hallo Alex,

ja, die Einflüsse der Änderungen an allen mögichen Stellen ...

Beim Einsetzten von Daten in SPalte I oder K auf dem kopierten Blatt wirkt das Makro ... sheetchange..., da der Blattname nicht ausgeschlossen wird.

Ich habe daher jetzt im Makro Kopieren am Ende den Blattschutz nochmal deaktiviert und die Events verhindert. Die geänderten oder eingefügten Zeilen sind wieder korrekt mit <-- hier markiert. Ein Part zum Farben entfernen in Spalte 7 habe ich raus genommen, das dürfte sich mit der kürzlich eingefügten Entfernung der Farben ab Zeile 19 erledigt haben (Rows("19:3000")...
Übrigens, in der Musterdatei auf dem Blatt Daten2 sind auch die Eintragungsspalten gesperrt, da stolpert das Makro gelegentlich auch drüber.

Hinweis: Falls das Makro nach dem Verhindern der Events abgebrochen wird, gilt das so lange, bis Du Excel neu startest - oder den code nochmal ausführst. Es würde dazu auch ein kleines Sub reichen mit der entsprechenden codezeile.

Hier jetzt der Teil aus dem Makro mit den Änderungen:

'

Code:

temporaeres Blatt aktivieren
tmpWsh.Activate
'Blattschutz aufheben                 '<-- hier
tmpWsh.Unprotect                      '<-- hier
'Eventmakros verhindern               '<-- hier
Application.EnableEvents = False      '<-- hier
'Mit der zelle fuer die Gesamtsumme
With Cells(Cells(Rows.Count, 9).End(xlUp).Row + 2, 10)
  'Gesamtsumme eintragen
  .Value = sSum
  'In Zelle links daneben "Summe" eintragen
  .Offset(0, -1).Value = "approx. total amount"
  'Euroformat
  .NumberFormat = "#,##0.00 $"
  'Fett
  .Font.Bold = True
'Ende Mit der zelle fuer die Gesamtsumme
End With
'Spaltenbreite automatisch anpassen
Cells.EntireColumn.AutoFit
'Spalte A und B ausblenden
Columns("A:B").EntireColumn.Hidden = True
'Farben rausnehmen
'Columns(7).Interior.Color = xlNone  '<-- hier
'Spaltenbreite automatisch anpassen
Cells.EntireColumn.AutoFit
'Spalte A und B ausblenden
Columns("A:B").EntireColumn.Hidden = True
'Farben rausnehmen
Rows("19:3000").Interior.Color = xlNone '<-- hier Startzeile und eventuell Endzeile anpassen
'Eventmakros erlauben                 '<-- hier
Application.EnableEvents = False      '<-- hier
End Sub

[Kuwer]

Hallo Zusammen,

um weiterer Verwirrung vorzubeugen:

Falsch:

Code:

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

Richtig:

Code:

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

Ist mir direkt so ins Auge gestochen.

Gruß Uwe

[Alex105]

Hallo Kuwer,

vielen Dank für die Info

@Schauan: jetzt passieren komische Dinge

1. Ich hab jetzt alle Zellen, in jedem Tabellenblatt gesperrt und "I" & "K" nicht. Excel zu (gespeichert) Excel auf und siehe da, alles dicht bis auf "I" & "K". Das scheint somit zu laufen

ABER:

Wenn ich jetzt clear worksheet mache kommt:

"Laufzeitfehler" '1004': Anwendungs- oder objektdefinierter Fehler

Debuggen =

Code:

If blaetter.Name <> "Input" And blaetter.Name <> "Sales" Then
    'letzte belegte Zelle in Spalte I               '<-- ab hier
    loLastRow = WorksheetFunction.Max(blaetter.Cells(Rows.Count, 9).End(xlUp).Row, 3)
    'Spalte I ab Zeile 3 bereinigen
    blaetter.Range("I3:I" & loLastRow).Value = "" <--HIER
    'letzte belegte Zelle in Spalte I

UND

Beim kopieren verschiebt er mir jetzt Zeilen :,-(

Es sieht so aus, als würde er die Hotkey nicht mehr kopieren. Entsprechen fäng er wo sonst unter "KEY" die Zahl stehen sollte, jetzt mit dem Preis an :15: meine Kunden (inkl. Chefe) würden das nicht abfeiern, wenn sie statt 1.000,00 € jetzt 125.486 da stehen hätten

Können wir da nochmal drüber sch(a)u(a)n :100:

Danke und Gruß
Alex

[schauan]

Hallo Alex,

bin noch am arbeiten .. Hier erst mal der neue code für das cellReset - bitte wieder komplett ersetzen. Das mit dem Zeilen verschieben konnte ich noch nicht nachvollziehen. Ich gehe jetzt alle codes und Funktionen nochmal durch. Bitte auch den Hinweis von Uwe berücksichtigen.

Code:

'Bearbeitung zuruecksetzen
'_______________________________________________________
Sub cellReset()
'Variablendeklaration
Dim blaetter As Worksheet
Dim loLastRow As Long
'Schleife ueber alle Blaetter
For Each blaetter In Worksheets()
  'Wenn der Blattname nicht Input und Sales ist, dann
  If blaetter.Name <> "Input" And blaetter.Name <> "Sales" Then
    'wenn ein Bild drauf ist
    If blaetter.Pictures.Count > 0 Then
        'Blatt loeschen
        blaetter.Delete
    'oder wenn kein Bild drauf ist
    Else
        'letzte belegte Zelle in Spalte I  
        loLastRow = WorksheetFunction.Max(blaetter.Cells(Rows.Count, 9).End(xlUp).Row, 3)
        'Spalte I ab Zeile 3 bereinigen
        blaetter.Range("I3:I" & loLastRow).Value = ""
        'letzte belegte Zelle in Spalte I
        loLastRow = WorksheetFunction.Max(blaetter.Cells(Rows.Count, 11).End(xlUp).Row, 3)
        'Spalte I ab Zeile 3 bereinigen
        blaetter.Range("K3:K" & loLastRow).Value = ""
    'Ende wenn ein Bild drauf ist
    End If
  'Ende Wenn der Blattname nicht Input und Sales ist, dann
  End If
'Ende Schleife ueber alle Blaetter
Next
'Blatt INPUT bereinigen
Sheets("Input").Range("N8:N11, P6, B8:B11, B13, B14, A16, B16, N16:P16, S2, T2").Value = ""
'letzte belegte Zelle in Spalte G
loLastRow = WorksheetFunction.Max(Sheets("Sales").Cells(Rows.Count, 7).End(xlUp).Row, 3)
'Blatt SALES Spalte G ab G3 bereinigen
Sheets("Sales").Range("G3:G" & loLastRow).Value = ""
End Sub

[Alex105]

Hallo Schauan,

noch immer der gleiche Fehler :(

Code:

loLastRow = WorksheetFunction.Max(blaetter.Cells(Rows.Count, 9).End(xlUp).Row, 3) <-- HIER
        'Spalte I ab Zeile 3 bereinigen
        blaetter.Range("I3:I" & loLastRow).Value = ""

ich hab den Code einkopiert, aktiviert, Excel geschlossen (gespeichert), gestartet und abgespielt. Darauf dieser Fehler. Tut mir leid

Ergänzende Frage:

Wäre es möglich, dass wir die Eingabe in folgendem Verhalten ändern:

IST Stand:

Ich wähle einen Wert in "K" und darauf hin "I" = Die Zelle wird grün

Wähle ich einen Wert in "I" und darauf hin "K" = Färbt sich die Zelle nicht.

SOLL Stand:

Wenn ich einen Wert in "I" eingebe und darauf hin in "K" einen Wert aussuche, soll sich die Zelle jetzt grün färben.

Warum?: ich glaube die Natur des Menschen sieht vor, dass man von links nach rechts auswählt und nicht von rechts, nach links


Danke und viele Grüße
Alex

PS: Sagtest du nicht, du stehst um 5 Uhr auf? Und dann arbeitest du jetzt noch immer?! :05

[schauan]

Hallo ALex,
--5:00 Uhr: Wir müssen die Kuh ja mal vom Eis bekommen

Wenn der code an der Stelle hängen bleibt, tue bitte mal eine Überwachung hinzufügen und dort blaetter.name eingeben. Poste mir dann bitte den Blattnamen.

Hier der geänderte code vom kopieren:

Code:

'auf einem Blatt zusammenfassen
'_______________________________________________________
Sub Kopieren()
'Variablendeklarationen
'Objekte
Dim myWsh As Worksheet, tmpWsh As Worksheet, myRng As Range
'String
Dim strAddress As String, strFind As String
'Integer
Dim iCnt%, iPasteRow%, iSumRow%
'single
Dim sSum As Single
'temporäres Blatt hinzufügen. Beachte: In diesem Beispiel muss das Blatt
'manuell wieder geloescht werden!
Set tmpWsh = Worksheets.Add(before:=Sheets(1))
'Daten aus Input uebernehmen
With Sheets("Input")
Range("C7:D7").Value = .Range("A6:B6").Value
Cells(7, 4).NumberFormat = "0.00%" 'Formatierung in %
Range("C7:D7").Value = .Range("A6:B6").Value
Cells(8, 4) = .Cells(7, 2) 'Daten aus B7 nach E8
Cells(8, 5) = .Cells(7, 14) 'Daten aus N7 nach D8
Cells(9, 3) = .Cells(8, 1) 'Daten aus A8 nach C9
Cells(9, 4) = .Cells(8, 2) 'Daten aus B8 nach D9
Cells(15, 4) = .Cells(14, 2) 'Daten aus B14 nach D15
Cells(9, 5) = .Cells(8, 14) 'Daten aus N8 nach E9
Cells(14, 4) = .Cells(13, 2) 'Daten aus B13 nach D14
Range("D9:E9").NumberFormat = "m/d/yyyy" 'Datumsformat setzen
Range("C10:D12").Value = .Range("A9:B11").Value
Range("E10:E12").Value = .Range("N9:N11").Value
Range("C14:C15").Value = .Range("A13:A14").Value
Range("C16:D16").Value = .Range("A15:B15").Value
Range("E16:G16").Value = .Range("N15:P15").Value
Range("C17:G17").Value = .Range("C16:G16").Value
Range("C17:D17").Value = .Range("A16:B16").Value
Range("E17:G17").Value = .Range("N16:P16").Value
Cells(7, 6) = .Cells(6, 15) 'Daten aus O6 nach F7
Cells(7, 7) = .Cells(6, 16) 'Daten aus P6 nach G7
Cells(17, 8) = .Cells(17, 7) 'Daten aus G7 nach H7
Cells(17, 8) = .Cells(17, 7) 'In Spalte R (18) bearbeiter und in Spalte S (19) Datum & Zeit eintragen
.Cells(.Cells(Rows.Count, 19).End(xlUp).Row + 1, 19) = Application.UserName
.Cells(.Cells(Rows.Count, 19).End(xlUp).Row, 20) = Date + Time '-- Zellenbestimmung.
'In H2 Bearbeiter und in I2 Datum & Zeit eintragen
Cells(2, 8) = Application.UserName 'Namensstempel
Cells(2, 9) = Date + Time 'Datum und Uhrzeitstempel
'Bild kopieren und im aktiven Blatt in C1 einfuegen
.Shapes("Logo").Copy
ActiveSheet.Paste Range("C1")
'Ende Daten aus Input uebernehmen
End With
'Schleife ueber alle Blaetter
For Each myWsh In Worksheets
  '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
        'Blattschutz aufheben
        .Unprotect
        'Ueberschrift 1x kopieren
        'wenn Zelle C19 auf temporaerem Blatt leer ist, dann
        If tmpWsh.Cells(19, 3) = "" Then
          'aus Zeile 2 kopieren
          .Range("A2:M2").Copy
          'in Zeile 19 auf temporaerem Blatt einfuegen, Bereich ggf. anpassen
          tmpWsh.Paste tmpWsh.Range("A19")
        'Ende wenn Zelle C18 leer ist, dann
        End If
        'Wenn die Summe von Spalte I > 0 ist, dann
        If WorksheetFunction.Sum(.Range("I:I")) > 0 Then
            'Spalte A und B einblenden
            .Columns("A:B").EntireColumn.Hidden = False
            'Autofilter in Spalte G setzen
            .Columns("I:I").AutoFilter
            'Spalte I filtern nach Werten > 0, Filter bis zur letzten gefuellten Zeile in Spalte I + 1
            'Es darf in Spalte I also nix unter den Daten stehen.
            .Range("$I$1:$I$" & .Cells(Rows.Count, 9).End(xlUp).Row).AutoFilter Field:=1, Criteria1:=">0"
            'Tabellenname in temporaeres Blatt, Spalte C eintragen, letzte Zeile anhand Spalte I
            tmpWsh.Range("C" & tmpWsh.Cells(Rows.Count, 9).End(xlUp).Row + 2) = myWsh.Name
            'Zeile zum Einfuegen ermitteln, letzte Zeile anhand Spalte I + 2 (2 wegen Tabellennamen in Spalte C)
            iPasteRow = tmpWsh.Cells(Rows.Count, 9).End(xlUp).Row + 3
            'Bereich kopieren und in Tabelle2 einfuegen
           .Rows("2:" & .Cells(Rows.Count, 9).End(xlUp).Row).Copy tmpWsh.Range("A" & iPasteRow)
            'Zwischensumme
            'Summenzelle
            iSumRow = tmpWsh.Cells(Rows.Count, 5).End(xlUp).Row
            'mit der Summenzelle
            With tmpWsh.Range("J" & iSumRow + 1)
                'Zwischensumme einfuegen
                .Value = WorksheetFunction.Sum(Range("J" & iPasteRow & ":J" & iSumRow))
                'Euroformat
                .NumberFormat = "#,##0.00 $"
                'Zwischensumme merken / kumulieren
                sSum = sSum + .Value
            'Ende mit der Summenzelle
            End With
            'Autofilter in Spalte G zuruecksetzen
            .Columns("I:I").AutoFilter
            'Spalte A und B ausblenden
            .Columns("A:B").EntireColumn.Hidden = True
        'Ende Wenn die Summe von Spalte I > 0 ist, dann
        End If
        'Blattschutz setzen
        .Protect
    'Ende Wenn der Blattname vom temporaeren Blatt <> vom Blatt myWsh ist, dann
    End If
  'Ende mit dem Blatt myWsh
  End With
'Ende Schleife ueber alle Blaetter
Next
'temporaeres Blatt aktivieren
tmpWsh.Activate
'Blattschutz aufheben
tmpWsh.Unprotect
'Eventmakros verhindern
Application.EnableEvents = False
'Mit der zelle fuer die Gesamtsumme
With Cells(Cells(Rows.Count, 9).End(xlUp).Row + 2, 10)
  'Gesamtsumme eintragen
  .Value = sSum
  'In Zelle links daneben "Summe" eintragen
  .Offset(0, -1).Value = "approx. total amount"
  'Euroformat
  .NumberFormat = "#,##0.00 $"
  'Fett
  .Font.Bold = True
'Ende Mit der zelle fuer die Gesamtsumme
End With
'Spaltenbreite automatisch anpassen
Cells.EntireColumn.AutoFit
'Spalte A und B ausblenden
Columns("A:B").EntireColumn.Hidden = True
'Farben rausnehmen
Rows("19:3000").Interior.Color = xlNone '<-- hier Startzeile und eventuell Endzeile anpassen
'Eventmakros erlauben
Application.EnableEvents = True
End Sub

[schauan]

Hallo ALex,

grün: Die Zeile färbt sich generell dann, wenn ich in I etwas eingebe, da spielt es keine Rolle, ob vorher oder hinterher etwas in K ausgewählt wurde oder wird. Dass man in I etwas wählen kann, hab ich noch nicht entdeckt.