Hilfe bei "Gesamtprojekt"

[CBRA]

Hallo liebe Excel-Könner!

Ich programmiere mir mit Excel-VBA immer mal wieder Kleinigkeiten zurecht, die mir meinen Alltag etwas erleichtern sollen. Nun habe ich eine Datei erzeugt, die mittlerweile sehr sehr langsam läuft, weil sie wahrscheinlich viel zu oft zu viel berechnet ohne dass das wirklich notwendig ist. 

Ferner habe ich wieder ein paar neue Ideen, um mir und meinen Kollegen das Leben etwas zu erleichtern, jedoch macht das nur Sinn, wenn auch die Geschwindigkeit nicht noch mehr leidet. 

Vielleicht kann mir jemand aus dem Forum erklären, wie ich manche Dinge effizienter machen kann oder wie ich manche Dinge überhaupt umsetzen kann. 

1. Nach jedem Eintrag in der Spalte A macht er die nächste Zeile sichtbar und setzt die Zeile auf rot. Bis ich mit Tab weitergehen kann dauert allerdings ein paar Sekunden, was rechnet er dann und warum dauert das so lange?
2. ich möchte in der Spalte Q genau wie in Spalte M folgendes haben: bei neuer Zeile ist alles rot und er trägt in Spalte M automatisch "e-Mail" ein. Bei Doppelklick auf "e-Mail" soll er die Zelle grün setzen und den Text auf versendet umtragen. In beiden Spalten soll dann natürlich auch eine Mail angestoßen werden mit Inhalt, das ist einmal 'sendMailwithSignature' und einmal 'sendMailwithSignatureRVD'

Info: Die Excel-Datei besteht aus ca. 20 Arbeitsblättern. Es wird aber immer nur auf der aktuellen (aktuelles Jahr) gearbeitet. Der Rest ist quasi Ablage. 

Wenn noch mehr Informationen gebraucht werden, dann gebe ich euch alles gerne. Ich habe manche interne Information jetzt reduziert, damit keine Daten sichtbar sind. Das hat aber mit dem Problem nichts zu tun. 

Ich bin für jeden Optimierungstipp dankbar. Ich habe mir Excel-VBA nur durch Foren angelesen und setze es immer für meine Bedürfnisse um. Ich kann also keine komplizierten Sachverhalte selbst programmieren. Wahrscheinlich übersehe ich ja daher auch etwas und bin auf Hilfe angewiesen.

Ich danke für jede Hilfe und wünsche jedem von euch einen guten Start ins neue Jahr! 

Christian

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Zeile As Integer
Zeile = 4

'Zeilen in Abhängigkeit der Eintragung einblenden
  For Zeile = 4 To 219
    If Range("A" & Zeile) <> "" Then
    Rows(Zeile + 1).EntireRow.Hidden = False
    Else: Rows(Zeile + 1).EntireRow.Hidden = True
    End If
  Next Zeile
 
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
   
    Dim Zeile As Integer
    Zeile = Split(ActiveCell.Address, "$", -1, vbTextCompare)(2)

    Cancel = True
    If Intersect(Target, Range("M4:M218")) Is Nothing Then Exit Sub
    ActiveSheet.Range("M" & Zeile).Interior.Color = RGB(0, 176, 80)
    ActiveCell.Value = "versendet"
    Call sendMailwithSignature
       
End Sub

'Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
'
'    Dim Zeile As Integer
'    Zeile = Split(ActiveCell.Address, "$", -1, vbTextCompare)(2)
'
'    Cancel = True
'    If Intersect(Target, Range("Q4:Q218")) Is Nothing Then Exit Sub
'    ActiveSheet.Range("M" & Zeile).Interior.Color = RGB(0, 176, 80)
'    ActiveCell.Value = "versendet"
'    Call sendMailwithSignatureRVD
'
'End Sub

Public Sub sendMailwithSignature()

    Dim BETREFF, BODY, EMPFAENGER As String
    Dim objOL As New Outlook.Application
    Dim objMail As Outlook.MailItem
    Dim Zeile As Integer

    Zeile = Split(ActiveCell.Address, "$", -1, vbTextCompare)(2)

    BETREFF = "Antrag vom " & Tabelle1.Cells(Zeile, 3)
    BODY = "..." & vbCrLf

    EMPFAENGER = Tabelle1.Cells(Zeile, 6)
     
    Set objMail = objOL.CreateItemFromTemplate("\\...\Signatur OfMa.oft")
    objMail.Subject = BETREFF
    objMail.BODY = BODY
    objMail.To = EMPFAENGER
    objMail.CC = "123.de"
   
    objMail.Attachments.Add ("\\...\_A_Antragsformular_Stellungnahme.docx")
    objMail.Attachments.Add ("\\...\_A_StAnz2015.pdf")

    'Nachricht anzeigen
    objMail.Display
   
End Sub

Public Sub sendMailwithSignatureRVD()

    Dim BETREFF, BODY, EMPFAENGER As String
    Dim objOL As New Outlook.Application
    Dim objMail As Outlook.MailItem
    Dim Zeile As Integer

    Zeile = Split(ActiveCell.Address, "$", -1, vbTextCompare)(2)

    BETREFF = "Bewertung " & Tabelle1.Cells(Zeile, 5) & "Az.: 123 " & Tabelle1.Cells(Zeile, 1)
    BODY = "Sehr geehrte Kollegin, sehr geehrter Kollege," & vbCrLf & vbCrLf & "der Magistrat " & Tabelle1.Cells(Zeile, 5) & vbCrLf

    'EMPFAENGER = Tabelle1.Cells(Zeile, 6)

    Set objMail = objOL.CreateItemFromTemplate("\\...\Signatur OfMa.oft")
    objMail.Subject = BETREFF
    objMail.BODY = BODY
    'objMail.To = EMPFAENGER
    objMail.CC = "123.de"

    objMail.Attachments.Add ("\\...\03_Checkliste_.xlsx")

    'Nachricht anzeigen
    objMail.Display

End Sub

[CBRA]

Ergänzung:

Natürlich sind viele bedingte Formatierungen dabei, die die Datei langsam werden lassen.

Ich habe diese noch einmal angefügt.

Zudem holt er sich aus anderen Referenzdateien (xlsx) Werte zum eintragen.

Schön wäre es tatsächlich, wie ich des Funktion mit dem Doppelklick (Worksheet_BeforeDoubleClick) für zwei Zellen zur Verfügung stellen kann, die jedes Mal eine andere Mail anstößt.

Danke!

[Klaus-Dieter]

Hallo,

habe mir dein "Buch" jetzt nicht vollständig durchgelesen. Anhand deiner Bilder lässt sich das Problem nur schwer nachvollziehen. Am besten du stellst deine Datei mal ein, sensible Daten kannst du anonymisieren. Die Quelltexte sind ohne die dazu gehörigen Daten, bei der Fehlersuche, auch nicht viel wert.

[ralf_b]

Sind in den Archivblättern auch noch die Formeln und Formatierungen aktiv?

[CBRA]

Ich habe die Datei anonymisiert als ZIP hochgeladen, sonst wäre sie zu groß gewesen. Ich hoffe, das passt so und ihr könnt damit was anfangen.

In den Archivblättern sind nur Altdaten, die vor meiner Zeit angelegt wurden. Ich habe das erst seit 2021 in Obhut und versuche das zu "optimieren". In den alten Blättern gab es keine Formatierungen und Formeln, da hat man einfach Zahlen und Buchstaben eingetragen. Niemand hat sich mit dem Excel beschäftigt, was es eigentlich kann. im Normalfall würde ich auch eher eine Datenbank dafür hernehmen, allerdings kann ich nur das nehmen, was ich zur Verfügung gestellt bekomme und das ist Excel.

Vielen Dank, dass ihr euch das anschaut!

[ralf_b]

ich weis leider nicht ob es soviel ausmacht aber dein Filter geht bis letzte Spalte.  
warum filterst du nicht nur den benutzten Bereich? 

ansonsten wäre n och das ausblenden. das erledigst du Zeile für Zeile. Dadurch entstehen einzelne Aktionen, die jedesmal andere Aktionen auslösen. 
Bis diese erledigt sind, muß man warten.
 
schalte die Berechnungsoption vorher auf manuell und das Screenupdating auch. Evtl noch die Events
nach der Schleife wieder einschalten.

in Tabelle1 wird beim Worksheet_change  eine Schleife aufgerufen, also immer wenn sich was ändert.  Jedes ausblenden einer Zeile!

Zu Beginn des Schleife blende alle Zeilen ein. 
Sammle in der Schleife die auszublendenden Zeilennummer mittels einer Union-Anweisung und blende sie am ende alle auf einmal aus.

[Gast 123]

Hallo

die Datei ist mir beim öffnen ein Rätsel, weil es sehr lange dauert.  Es gibt eine einzige Verknüpfung die mir auch Rätselhaft ist.  Obwohl sie exisitert konnte ich nicht herausfinden WIE die Datei verknüpft ist??   Es gibt keine externen Formeln, keine verknüpften Objekte!!  Und doch wird eine Verknüpfung angezeigt.

Ändere bitte mal das Change Makro für Tabelle 2021, dann braucht ihr wenigstens nicht mehr Sekundenlang auf die nächste Eingabe zu warten!!
Vielleicht hilft euch der kleine Code ja schon richtig weiter.  Würde mich freuen.  Herzliche Grüsse an die Polizei in Hessen von einem Kölner aus Ankara.

mfg Gast 123

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
If Target.Column = 1 Then
   If Target.Value <> "" Then
       'nächste Zeile einblenden
       Rows(Target.Row + 1).EntireRow.Hidden = False
       Target.Offset(0, 1).Select
   ElseIf Target.Value = "" Then
       Rows(Target.Row + 1).EntireRow.Hidden = True
       Target.Select
    End If
End If
Exit Sub
Fehler: MsgBox "unerwarteter Target Fehler"
End Sub

[Warkings]

Die Datei ist jetzt nicht wirklich komplett anonymisiert, oder warum steht da noch eine reale E-Mail Adresse drin. 

Ansonsten sehe ich den typischen Fehler, dass die Events m Event-Code nicht ausgeschaltet werden, was zur Folge hat, dass die Events mehrfach getriggert werden.

Und um Deine Frage zu beantworten, ob man den Code effizienter gestalten kann: Ja, kann man. Wegwerfen und neu machen. Sorry, wenn das hart klingt, aber den "Murks" will doch keiner aufpeppen.

Um Dich jetzt nicht total "abzuwatschen", man könnte zumindest das mehrmalige Auslösen der Events nach dem Muster ausschalten

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Zeile As Integer
    Zeile = 4

    On Error GoTo EH
    Application.EnableEvents = False
   
    'Zeilen in Abhängigkeit der Eintragung einblenden
    For Zeile = 4 To 219
        If Range("A" & Zeile) <> "" Then
            Rows(Zeile + 1).EntireRow.Hidden = False
        Else: Rows(Zeile + 1).EntireRow.Hidden = True
        End If
    Next Zeile
   
EH:
    Application.EnableEvents = True
 
End Sub

und 

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
   
   
    Dim Zeile As Integer
   
    On Error GoTo EH
    Application.EnableEvents = False
   
    Zeile = Split(ActiveCell.Address, "$", -1, vbTextCompare)(2)
    ' Zeile = Target.Row

    Cancel = True
    If Intersect(Target, Range("M4:M219")) Is Nothing Then Exit Sub
    ActiveSheet.Range("M" & Zeile).Interior.Color = RGB(0, 176, 80)
    ActiveCell.Value = "versendet"
    Call sendMailwithSignature   ' Besser  Call sendMailwithSignature (Zeile) und keine Neu-Ermittlung

EH:
    Application.EnableEvents = True
       
End Sub

Damit werden die unnötigen Event Aufrufe unterbunden

Further reading
Declaring Variables (cpearson.com)
Deklarieren von Variablen (VBA) | Microsoft Docs
Important : Declaring multiple Variables with one Dim Statement - Welcome to LearnExcelMacro.com

Events In Excel VBA (cpearson.com)

[ralf_b]

  Obwohl sie exisitert konnte ich nicht herausfinden WIE die Datei verknüpft ist??   Es gibt keine externen Formeln, keine verknüpften Objekte!!  Und doch wird eine Verknüpfung angezeigt.

Datenvalidierung Blatt NH    J11- J13 , J15, J36, J108

aus irgend einem Grund ist die in diesen Zelle verschieden zu den anderen dieser Spalte.

[Gast 123]

Hallo Ralf

ich bedanke mich für deine Info mit der Datenvalidierung und frage höflich.  hast du ein Makro um das für eine ganze Mappe aufzulisten?
Oder einen guten Codeschnipsel mit dem ich mir so etwas selbst "stricken" kann?

zum Nachdenken!   das bringt mich an den Rand meines könnens .....   '
Aber als hartnäckiger Praktiker frage ich mich wie das funktioniert????   Ein lustiges Ratespiel für exellente Excel Profis, denke ich.

Ich habe im Blatt NH die genannten Zellen auf das vorhandeneBlatt MESSGERAETE und eine Spalte davor Zellen auf MESSTECHNIK geändert.
Mit dem unteren Code bekam ich immer noch Verknüpfungen angezeigt. Im Originalblatt fand ich per MsgBox ein Blattobject, "DropDown1"

Nach dem löschen des Objektes bekam ich immer noch Verknüpfungen angezeigt und löscht gezielt eine Spalte nach der anderen bis zum Ende!
Zum Schluss war das ganze Blatt leer und ich bekam immer noch Verknüpfungen angezeigt. Dann löschte ich das Blatt NH, Verknüpfungen weg!!

Hast du dafür eine Erklärung was in einem -völlig leeren Blatt ohne Objekte -noch verknüpft sein  kann.???  Da zweifele ich an meinem Excel Wissen ...


@Warkings  als ich den Code für Eingabe auf eine einzige Zeile änderte prüfte ich mit einer MsgBox ob er mehrfach aufgerufen wird.  Wird er nicht!
    deine Idee EventsEnable einzubauen mag fachlich koirrekt sein, dann werden aber alle 419 Zeilen mi Hidden bearbeitet. Das kostet unnnbötig Zeit.

Ob die Datei schneller läuft oder schneller öffnet wenn wir die Verknüpfungen heraus bekommen weiss ich nicht. Würde es aber aus Neugier gerne testen!!

mfg Gast 123

In diesem Sinne allen Kollegen und der Polizei in Hessen und der ganzen BRD ein frohes, gesundes und glückliches neues Jahr 2022

---

das war mein Code zum prüfen:

Code:

Sub MW_Verknuepfungen_auflisten()
     alinks = ActiveWorkbook.LinkSources(xlExcelLinks)
     If Not IsEmpty(alinks) Then
         MsgBox UBound(alinks) & "  Verknüpfungen!"
     Else
         MsgBox "Diese Arbeitsmappe enthält keine Verknüpfungen!"
     End If
End Sub