Suchen, Auswählen, Merken, Drucken

[schauan]

Hallo Alex,

der Punkt ist, dass Du auf den meisten Blättern die Überschrift in Zeile 2 und auf zwei in Zeile 3 hast - dort gibt es dann noch Untergruppen. Da war ja meine Frage vor einigen Beiträgen, ob Du das ändern kannst.
Ansonsten müsste ich Excel prüfen lassen, ob z.B. in E3 eine Zahl oder ein Text steht - das müsste dann aber auch auf 100% der Datenblätter anwendbar sein, oder Du hast noch andere Kriterien, wo man das festmachen könnte.

[Alex105]

Hallo Schauan,

ich hatte in Erinnerung, dass wir darüber gesprochen haben und auch nach diesem Beitrag gesucht. Ich hatte dir ja zugesichert, dass ich die Überschrift eine Zeile hoch setzte und das habe ich auch getan :21:

"Needed Number" bzw. "Select Timeline" stehen in jedem Tabellenblatt "I2" bzw. "K2".

Hab ich evtl. (wieder mal) vergessen was einzukopieren?!

Viele Grüße
Alex

[schauan]

Hallo Alex,

das konnte passieren, wenn auf dem Blatt keine Eintragungen erfolgten. Ich hab das jetzt geändert, ebenso die "grauen Streifen". Irgendwie spinnt mein Excel. Ich mach hier Änderungen, hab nur eine Datei Offen, teste, gehe in die codes, und hab dort wieder die ungeänderten Stände ...

Hier wieder für SheetChange in DieseArbeitsmappe:
--> da hab ich da smit den ungeänderten gerade gemerkt - ich ändere den jetzt nochmal und malde mich gleich wieder.


und hier cellReset, auch wieder der zweite Versuch ...

Code:

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
    '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 = ""
    '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 = ""    '<-- bis hier
    'Blatt loeschen, wenn ein Bild drauf ist
    If blaetter.Pictures.Count > 0 Then blaetter.Delete
  'Ende Wenn der Blattname nicht Input und Sales ist, dann
  End If
'Ende Schleife ueber alle Blaetter
Next
'Blatt INPUT bereinigen
Sheets("Input").Range("B6, P6, B8:B11, B13, B14, A16, B16, N16:P16").Value = ""
'Blatt SALES Spalte G ab G3 bereinigen
Sheets("Sales").Range("G3:G1048576").Value = ""
End Sub

[schauan]

... hier jetzt aus DieseArbeitsmappe ..SheetChange..

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 And Target.Areas.Count = 1 Then
         'Schleife ueber alle gewaehlten Zellen
          For Each zellen In Target
            'Mit dem Bereich Spalte C (3) bis M (13)
            With Sh.Range(Sh.Cells(zellen.Row, 3), Sh.Cells(zellen.Row, 13))
              'Wenn Inhalt > 0 ist, dann mit ... einfaerben, sonst Farbe rausnehmen
              If zellen > 0 And zellen.Offset(, -1) <> "" Then
                .Interior.Color = 5296274
              ElseIf zellen.Offset(, -1) <> "" Then
                .Interior.Color = xlNone
              End If
           'Ende Mit dem Bereich Spalte C (3) bis M (13)
           End With
         '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

[Alex105]

Hallo Schauan,

funktioniert (scheinbar) sehr gut

Morgen füge ich noch den Code für die gesperrten Zellen ein

Kann ich dir noch eine verständnis Frage stellen?

Ist es kompliziert das auch für Versionen ab 2003 ans Laufen zu bekommen?!

Danke für alles und bis morgen :100:
Alex

[schauan]

Hallo Alex,

meinst Du ab oder bis? Laufen müsste es derzeit in 2007 / 2010 und 2013.
Testen könnte ich momentan noch 2000 - falls mein alter W2K-Laptop überhaupt noch angeht, für 2003 müsste ich mir erst eine VM installieren, das würde aber etwas dauern. Falls Du irgendwo 2003 hast, kannst Du es ja mal versuchen.
Es dürfte zwei Stolperstellen geben - das ein(fach)e ist diese Zeile:
Sheets("Sales").Range("G3:G1048576").Value = ""
Hier musss die große Zahl auf die niedrigere Zeilenanzahl in 2003 reduziert werden.
Das andere ist die pdf-Ausgabe. Die muss total anders erfolgen - auf dem Rechner mit 2003 muss irgendein entsprechendes Programm installiert sein, wie z.B. Adobe oder ein pdf-Drucker.
Mit Adobe hab ich allerdings nix am Hut

Unter 2007 muss für die pdf-Ausgabe das entsprechende AddIn installiert werden - das gab's damals glaube als Extra bei Microsoft. Dann könnte der code auch funktionieren - kann ich momentan allerdings auch nicht testen.

[Alex105]

Hallo Schauan,

ich hoffe, du hattest einen erfolgreichen Tag?

Also, dein Code für das Kopieren trotz gesperrter Zellen läuft leider nicht :(

Bzgl. meiner Frage von gestern Abend. Ich meinte ab 2003

Und heute neu

Die Zellen "I" & "K" sind jetzt alle dunkel grau abgestuft (ich möchte so kenntlich machen, dass das die einzigen Zellen sind, die ein Kunde ausfüllen kann). Nach abpielen des "Clear Worksheets" ist die Farbe natürlich wieder weg haben wir eine Chance, dass es dann wieder grau wird?!

Vielen Dank und viele Grüße

Alex

PS: wir sind jetzt bei 95% würde ich schätzen :)

[schauan]

Hallo Alex,
Kannst Du mir bitte mal die Datei mit den gesperrten Zellen schicken?
Danke,

[Alex105]

Hallo Schauan,

hier die neue Mustertabelle, mit allen in der originalmappe befindlichen Codes

und die Zellen sind gesperrt.

Danke und viele Grüße
Alex

[schauan]

Hallo Alex,

hier die geänderten Makros für Diene Exceldatei. Den Blattschutz muss ich bei einigen Aktionen temporär aufheben und danach wieder setzen. Im Moment hat der kein Passwort. Wenn jemand mal eins einträgt, würde der code wieder nicht laufen. Man müsste es dann im code fest programmieren - allerdings im Klartext. Wenn ein Makro, was den Blattschutz aufhebt, mal abbricht, dann ist das entsprechende Blatt ungeschützt und wird erst beim nächsten Makrodsurchlauf, wo der Blattschutz angefasst wird, wieder gesetzt.

in DieseArbeitsmappe

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 And Target.Areas.Count = 1 Then
         'Blattschutz aufheben            '<-- hier
         Sh.Unprotect                     '<-- hier
         'Schleife ueber alle gewaehlten Zellen
          For Each zellen In Target
            'Mit dem Bereich Spalte C (3) bis M (13)
            With Sh.Range(Sh.Cells(zellen.Row, 3), Sh.Cells(zellen.Row, 13))
              'Wenn Inhalt > 0 ist, dann mit ... einfaerben, sonst Farbe rausnehmen
              If zellen > 0 And zellen.Offset(, -1) <> "" Then
                .Interior.Color = 5296274
              ElseIf zellen.Offset(, -1) <> "" Then
                .Interior.Color = xlNone
                'Hellgrau in Spalte I und K setzen                   '<-- hier
                Sh.Cells(zellen.Row, 9).Interior.Color = 15921906       '<-- hier
                Sh.Cells(zellen.Row, 11).Interior.Color = 15921906      '<-- hier
              End If
           'Ende Mit dem Bereich Spalte C (3) bis M (13)
           End With
         'Ende Schleife ueber alle gewaehlten Zellen
         Next
         'Blattschutz setzen              '<-- hier
         Sh.Protect                       '<-- hier
       '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

im MOdul, Makro Kopieren diesen Teil ersetzen:

Code:

'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            '<-- hier
        .Unprotect                       '<-- hier
        '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 G > 0 ist, dann
        If WorksheetFunction.Sum(.Range("G:G")) > 0 Then
            'Spalte A und B einblenden
            .Columns("A:B").EntireColumn.Hidden = False
            'Autofilter in Spalte G setzen
            .Columns("G:G").AutoFilter
            'Spalte G filtern nach Werten > 0, Filter bis zur letzten gefuellten Zeile in Spalte G + 1
            'Es darf in Spalte G also nix unter den Daten stehen.
            .Range("$G$1:$G$" & .Cells(Rows.Count, 7).End(xlUp).Row).AutoFilter Field:=1, Criteria1:=">0"
            'Tabellenname in temporaeres Blatt, Spalte C eintragen, letzte Zeile anhand Spalte G
            tmpWsh.Range("C" & tmpWsh.Cells(Rows.Count, 7).End(xlUp).Row + 2) = myWsh.Name
            'Zeile zum Einfuegen ermitteln, letzte Zeile anhand Spalte G + 2 (2 wegen Tabellennamen in Spalte C)
            iPasteRow = tmpWsh.Cells(Rows.Count, 7).End(xlUp).Row + 3
            'Bereich kopieren und in Tabelle2 einfuegen
           .Rows("2:" & .Cells(Rows.Count, 7).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("G:G").AutoFilter
            'Spalte A und B ausblenden
            .Columns("A:B").EntireColumn.Hidden = True
        'Ende Wenn die Summe von Spalte G > 0 ist, dann
        End If
        'Blattschutz setzen              '<-- hier
        .Protect                         '<-- hier
    '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

Ich habe dann noch am Ende vom cellReset die Zeilenzahl flexibel gemacht, wegen 2003:

Code:

'letzte belegte Zelle in Spalte G
loLastRow = WorksheetFunction.Max(blaetter.Cells(Rows.Count, 7).End(xlUp).Row, 3)
'Blatt SALES Spalte G ab G3 bereinigen
Sheets("Sales").Range("G3:G" & loLastRow).Value = ""