Registriert seit: 07.07.2014
Version(en): 2007/2010
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
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
Hallo Alex,
Hast Du den ganzen code von...sheetchange.. übernommen? Bei mir lief es damit. Ich teste es noch mal.
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 07.07.2014
Version(en): 2007/2010
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
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
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
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 17.04.2014
Version(en): MS Office 365(32)
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
Registriert seit: 07.07.2014
Version(en): 2007/2010
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
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
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
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 07.07.2014
Version(en): 2007/2010
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
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
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
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
Registriert seit: 10.04.2014
Version(en): 97-2019 (32) + 365 (64)
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.
. \\\|/// Hoffe, geholfen zu haben.
( ô ô ) Grüße, André aus G in T
ooO-(_)-Ooo (Excel 97-2019+365)
|