Makro anstelle der bedingten Formatierung für die folgenden Buchstaben U,T,S,G,K
#1
Hallo zusammen,

mein Abwesenheitsplaner.xlsb ist 7.829 KB groß. Deshalb ist die Datei sehr langsam. 
Bei meinen Recherchen fand ich heraus, dass die bedingte Formatierungen eine der vielen Ursachen sein kann. 


Ich habe etwas gegoogelt und fand folgendes Makro

Code:
Sub Farbe()
Dim Zelle As Range
For Each Zelle In ActiveSheet.UsedRange
If Zelle.Value = "T" Then
Zelle.Interior.ColorIndex = 3
Zelle.ClearContents
End If
If Zelle.Value = "U" Then
Zelle.Interior.ColorIndex = 5
Zelle.ClearContents
End If
Next Zelle
End Sub

Der Nachteil des Codes ist, dass das Makro die Buchstaben unerkenntlich macht, und die Dropdown-Liste der Zelle auch löscht. Mann kann anschließend bei einer falschen Eingabe nicht mehr eine Auswahl treffen.

Eine Beispiel-Datei der original Datei ohne Personennamen habe ich hinzugefügt.
Ich bedanke mich für die Unterstützung....


Angehängte Dateien
.xlsx   Abwesenheit.xlsx (Größe: 500,04 KB / Downloads: 12)
Antworten Top
#2
Nimm mal die Zeilen Zelle.ClearContents raus, dann werden die Inhalte auch nicht gelöscht.

Deine Gültigkeitsprüfungen laufen bei mir ins Leere, da ich die verlinkte Datei nicht besitze und zudem Bezugsfehler enthalten sind.
[-] Folgende(r) 1 Nutzer sagt Danke an Gast für diesen Beitrag:
  • Tommiks
Antworten Top
#3
Es wäre besser alle überflüssige Formatconditions zu löschen:

Code:
Sub M_snb()
  MsgBox Sheet1.Cells.FormatConditions.Count
End Sub

Und studiere mal bitte 'conditional Formatting.
z.B. Eigenschaft 'Applies To'
statt '=$N$6'
'=$N$6:$S$6;$X$7:$NV$360'
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
[-] Folgende(r) 1 Nutzer sagt Danke an snb für diesen Beitrag:
  • Tommiks
Antworten Top
#4
Hallöchen,

manche nutzen eine Datei auch über Jahre, löschen zum Jahreswechsel nur die Inhalte und machen im Folgejahr mit dieser Datei weiter. Da kann sich auch mit der Zeit was aufbauen. Erzeuge eine neue Vorlage und setzte diese jedes Jahr ein.
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
[-] Folgende(r) 1 Nutzer sagt Danke an schauan für diesen Beitrag:
  • Tommiks
Antworten Top
#5
@EarlFred,

vielen Dank, das war die Lösung.

Jetzt erkenne ich ein anderes Problem.

Der Code reagiert nicht simultan. 
Wenn ich in einer Zelle "U" auswähle, wird die Farbe nicht geändert. Die Farbe ändert sich nur dann, wenn ich "Makro Ausführen" betätige. Anbei die Datei mit der korrigierten Quelle.

@Schauan,

die Vorlage ist neu. Sie ist keine Kopie einer alten Datei. Das Problem ist in der gleichen Datei befinden sich 14 Schichtplan-Arbeitsblätter ,die mit SVERWEISEN die Abwesenheit der MA abfragen. Ohne diese Anhänge waren die zwei Blätter gar nicht langsam. 

@snb,

vielen Dank für deine Hilfestellung .Ich habe leider deine Ausführung nicht verstanden.


Angehängte Dateien
.xlsb   Abwesenheit.xlsb (Größe: 274,41 KB / Downloads: 5)
Antworten Top
#6
Hi,

versuche mal diesen Code in deinem Tabellenblatt.
dieser Code wird ausgeführt, wenn du eine Änderung in den Zellen durchführst.
p.s den restlichen Code (Farbgestaltung), darfst du selber fertigstellen. :)

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ErrMsg
    Dim rngTarget As Range, myColorindex As Integer
    Set rngTarget = Range("X7:NV400")
    If Not Intersect(Target, rngTarget) Is Nothing Then
       If Target.CountLarge < 50 Then
            For Each Target In Target
                Select Case Target.Value
                    Case "T"
                        myColorindex = 3
                    Case "U"
                        myColorindex = 4
                    Case ""
                        myColorindex = xlNone
    '                Case "was auch immer"
    '                    myColorindex = deine Farbnummer
    '                usw...
                End Select
                Target.Interior.ColorIndex = myColorindex
                cancel = True
            Next
        Else
            Application.EnableEvents = False
            Application.Undo
            Application.EnableEvents = True
        End If
    End If
    Exit Sub
ErrMsg:
    MsgBox Err.Number & Err.Description
    Application.EnableEvents = True
End Sub
lg Chris
Feedback nicht vergessen.
[Bild: v.gif]
3a2920576572206973742064656e20646120736f206e65756769657269672e
[-] Folgende(r) 1 Nutzer sagt Danke an chris-ka für diesen Beitrag:
  • Tommiks
Antworten Top
#7
Hi,

nun ja, bei 265 Tagen * 401 Spalten = 146.365 Zellen und mindestens 8 bed.Form. für diese, braucht man sich nicht zu wundern, dass es träge wird. Erst recht nicht, wenn es sich bei einer der Formeln um einen SVerweis handelt. Du könntest schon viel Zeit sparen, wenn du die Feiertagsberechnung pro Spalte nur einmal durchführst (in einer ausgeblendeten Zeile z.B. Zeile 6) und deine bed.Form. von =SVERWEIS(V$1;Werkzeug!$B$2:$B$12;1;0) auf =V$6 und in V6 schreibst du den ursprünglichen SVerweis. umstellst. Das würde dir genau 144.000 SVerweise sparen. Eventuell wird es auch noch schneller, wenn du aus dem SVerweis ein =ZÄHLENWENN(Werkzeug!$B$2:$B$12;V$1) machst.

Wenn du dann noch deine bed.Form aufräumst und die Zeilenzahl auf as notwendige Maß begrenzt, dann sollte es so langsam flüssiger laufen.
Zum Schluß dann nur noch die ganzen WOCHENTAG-Formeln in den Bed.Form durch =(V$5="Sa")+(V$5="So") ersetzt, dürfte es noch etwas schneller werden. Oder gleich eine weitere Zeile einfügen, in der die Berechnung gemacht wird und nur noch (wie vorhin) =V$xx verwenden.
Gruß,
Helmut

Win10 - Office365 / MacOS - Office365
[-] Folgende(r) 1 Nutzer sagt Danke an HKindler für diesen Beitrag:
  • Tommiks
Antworten Top
#8
@chris-ka,

dein Code hat in der Datei, die hier hinzugefügt habe, tadellos funktioniert.

Als ich den Code in meine original Datei, in der ich noch zwei Codes habe, hinzugefügt habe, hat dein Code nicht mehr reagiert. Was könnte der Grund sein? Danke...
Ich füge die Datei mit den zwei zusätzlichen Codes ein.

In meiner Original Datei steht "1004Die Methode ' Undo ' für das Objekt _Application ist fehlgeschlagen".


Angehängte Dateien
.xlsm   Abwesenheitsplaner.xlsm (Größe: 556,11 KB / Downloads: 10)
Antworten Top
#9
Hi,

bei mir erschein der Fehler nicht...
https://youtu.be/ByJpsQey0hQ
lg Chris
Feedback nicht vergessen.
[Bild: v.gif]
3a2920576572206973742064656e20646120736f206e65756769657269672e
[-] Folgende(r) 1 Nutzer sagt Danke an chris-ka für diesen Beitrag:
  • Tommiks
Antworten Top
#10
@chris-ka,


hast Du auch eine Idee die vorhandenen Abwesenheiten mit einem Schlag in entsprechende Farben umzuwandeln, denn, wenn ich kleine Teile der Abwesenheiten kopiere, und einfüge, dann wird die Farbe geändert, aber das Kopieren, und Einfügen der ganzen Abwesenheiten führt nicht zum Ziel.
 
 
Kennst Du da eine Abhilfe? Danke...
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste