Code Optimierung

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Bild

Betrifft: Code Optimierung
von: Markus
Geschrieben am: 31.07.2015 07:58:34

Guten Morgen liebe Forumsmitglieder,
ich hatte vor kurzem schon den Beitrag eingestellt, jedoch noch keine Rückmeldung bekommen und weiß nicht, ob er ein wenig untergegangen ist. Daher stelle ich mein Anliegen nochmals ein. Nepumuk hatte mir vorab geholfen, eine Dropdownliste dynamisch anstatt statisch mit Werten zu füllen.
Thematisch geht es um eine Inputbox, die jetzt mit bestimmten Werten einer Spalte gefüllt wird. Je nach Auswahl wird eine andere Funktion geöffnet, die aber auf einen bestimmten Eingabewert reagiert. Die Dynamik der Dropdownliste ist somit zwar nett und war mir auch wichtig (allein, um das Verständnis zu bekommen), hilft aber eben nur bedingt weiter im Moment.
KS steht für Kostenstellen, von denen ca. 20 Stück in der Liste stehen.
Hier der alte Beitrag:

Die Dynamik der Liste hilft mir schonmal für zukünftige Projekte, bei dem aktuellen gibt es jedoch noch einen Zeilenlastigen Stolperstein.
Die Auswahl der KS wird ja durch "Ok" bestätigt und dadurch eine noch statische Funktion aufgerufen:


Private Sub OKCommandButton_Click()
    'Wertet die Auswahl der ComboBox aus
    If KSAuswahlComboBox.Value = 3405 Then
    Unload Me
    Call AuswahlfunktionZeile1
    End If
    'der selbe Code folgt dann für alle weiteren KS, ist aber definiert und dadurch statisch! _
End Sub
Zur Hintergrundinformation:
Die Auswahl der KS dient dazu, aus einem anderen Tabellenblatt die dazu passenden Daten aus einem bestimmten Jahr zu kopieren.
Die Anzahl der Codezeilen hierzu ist leider immens und statisch, sodass ich bei Änderung der KS (neue Nummer, oder komplett neue KS) den ganzen Code entweder anpassen oder kopieren und anpassen muss.

Hier der Code der "AuswahlFunktion1" nur für ein Jahr:

Public Sub AuswahlfunktionZeile1() 'Öffnet Inputbox zur Eingabe der Daten
    Dim s As Variant
    Dim p As String
    Dim rg As Range
    
    s = InputBox("Bitte geben Sie das gewünschte Jahr ein.", "Eingabefeld für: " &    _
Application.UserName)
        
            If s = "" Then 'Falls der Benutzer auf Abbrechen klickt, schließt sich so die  _
Inputbox
            Exit Sub
            End If
            
        If s = 2010 Then
            MsgBox "Aus diesem Jahr sind keine Daten hinterlegt.", vbOKOnly, "Keine Daten"
        End If
        
        If s = 2013 Then
            MsgBox "Aus diesem Jahr sind keine Daten hinterlegt.", vbOKOnly, "Keine Daten"
        End If
        
        If s = 2014 Then
            MsgBox "Aus diesem Jahr sind keine Daten hinterlegt.", vbOKOnly, "Keine Daten"
        End If
        
        'Muss für spätere Jahre angepasst werden
        If s = 2021 Then
            MsgBox "Für dieses Jahr ist die Programmierung noch nicht erfolgt." & Chr(13) & " _
Bitte
         kontaktieren Sie einen Mitarbeiter, der sich mit VBA-Programmierung auskennt.",
         vbOKOnly, "Programmierung fehlt"
        End If
        
'Auswahl, ob B1 oder B2, anschließend werden alle Daten aus der Tabelle "Daten" kopiert und in   _
 _
_
der Leistungsübersicht eingefügt
        If s = 2011 Then
        p = MsgBox("Stammen Ihre Daten von 2011 aus der Bewertung B1?" & Chr(13) & "Wählen Sie ' _
 _
 _
Nein',
        falls Ihre Daten B2 entstammen", vbYesNo, "Auswahl der Bewertung B1 oder B2")
        
            If p = vbYes Then
             Worksheets("Daten").Range("B5").Copy
             Worksheets("Leistungsübersicht").Range("D4").PasteSpecial xlPasteFormulas ' _
Kopieren der
             Daten aus "Daten" und Zellfärbung
             
                If Worksheets("Leistungsübersicht").Range("D4").Value >= 0.85 Then
                    Worksheets("Leistungsübersicht").Range("D4").Interior.Color = vbGreen
                End If
                If Worksheets("Leistungsübersicht").Range("D4").Value <= 0.85 And _
                 Worksheets("Leistungsübersicht").Range("D4").Value >= 0.75 Then
                    Worksheets("Leistungsübersicht").Range("D4").Interior.Color = vbYellow
                End If
                If Worksheets("Leistungsübersicht").Range("D4").Value <= 0.75 Then
                    Worksheets("Leistungsübersicht").Range("D4").Interior.Color = vbRed
                End If
                
             
             Worksheets("Daten").Range("D5").Copy
             Worksheets("Leistungsübersicht").Range("E4").PasteSpecial xlPasteFormulas
             Worksheets("Daten").Range("F5").Copy
             Worksheets("Leistungsübersicht").Range("F4").PasteSpecial xlPasteFormulas
             Worksheets("Leistungsübersicht").Range("F4").Value = _
             Worksheets("Leistungsübersicht").Range("F4").Value
             Application.CutCopyMode = False
             Set rg = Worksheets("Daten").Range _
             ("C5,H5,I5,N5,O5,T5,U5,Z5,AA5,AF5,AG5,AL5,AM5,AR5,AS5,AX5") 
             'Prüft, ob es noch neuere Werte gibt, AX5 ist notwendig, da sonst im jahr 2020 
             keine leere Zelle mehr vorhanden wäre und VBA einen Fehler meldet. 
             Wird das Jahr 2021 ergänzt, muss dann überall wiederum eine Zelle 
             hinzugefügt werden (z.B.BD5)
             If rg.SpecialCells(xlCellTypeBlanks).Count = rg.Count Then
             Worksheets("Leistungsübersicht").Range("J4").Interior.Color = vbGreen
             Worksheets("Leistungsübersicht").Range("J4").Value = "Ja"
             Else
             Worksheets("Leistungsübersicht").Range("J4").Interior.Color = vbRed
             Worksheets("Leistungsübersicht").Range("J4").Value = "Nein"
             MsgBox "Achtung, für diese Kostenstelle gibt es neuere Daten.", vbOKOnly, "Hinweis" _
 _
 _
             End If
             
             Else 'Falls Nein und damit B2 gewählt wird
             Worksheets("Daten").Range("C5").Copy
             Worksheets("Leistungsübersicht").Range("D4").PasteSpecial xlPasteFormulas
             
                If Worksheets("Leistungsübersicht").Range("D4").Value >= 0.85 Then
                    Worksheets("Leistungsübersicht").Range("D4").Interior.Color = vbGreen
                End If
                If Worksheets("Leistungsübersicht").Range("D4").Value <= 0.85 And _
                Worksheets("Leistungsübersicht").Range("D4").Value >= 0.75 Then
                    Worksheets("Leistungsübersicht").Range("D4").Interior.Color = vbYellow
                End If
                If Worksheets("Leistungsübersicht").Range("D4").Value <= 0.75 Then
                    Worksheets("Leistungsübersicht").Range("D4").Interior.Color = vbRed
                End If
                
             Worksheets("Daten").Range("E5").Copy
             Worksheets("Leistungsübersicht").Range("E4").PasteSpecial xlPasteFormulas
             Worksheets("Daten").Range("G5").Copy
             Worksheets("Leistungsübersicht").Range("F4").PasteSpecial xlPasteFormulas
             Worksheets("Leistungsübersicht").Range("F4").Value = _
             Worksheets("Leistungsübersicht").Range("F4").Value
             Application.CutCopyMode = False
             Set rg = Worksheets("Daten").Range _
             ("H5,I5,N5,O5,T5,U5,Z5,AA5,AF5,AG5,AL5,AM5,AR5,AS5,AX5")
             If rg.SpecialCells(xlCellTypeBlanks).Count = rg.Count Then
             Worksheets("Leistungsübersicht").Range("J4").Interior.Color = vbGreen
             Worksheets("Leistungsübersicht").Range("J4").Value = "Ja"
             Else
             Worksheets("Leistungsübersicht").Range("J4").Interior.Color = vbRed
             Worksheets("Leistungsübersicht").Range("J4").Value = "Nein"
             MsgBox "Achtung, für diese Kostenstelle gibt es neuere Daten.", vbOKOnly, "Hinweis" _
 _
 _
             End If
             
            End If
             
        End If
End Sub

Das ist nur der Code von einem Jahr. Insgesamt gibt es momentan 8 Jahre (2011,2012,2015-2020) und dadurch unglaublich viel Code, denn es gibt ja auch zusätzlich mehrere übergeordnete Kostenstellen, die alle wieder Daten für diese Jahre haben (bzw haben werden).
Mein Wunsch ist es, dass das ganze dynamisch funktioniert und ich nicht mehr tausende an Codezeilen habe.
Vielleicht ist es jetzt zu viel Arbeit, alles nochmal umzuschreiben. Falls dem so ist, sagt mir einfach bescheid :) Wie bereits gesagt wusste ich mir am Anfang nicht besser zu helfen, als alles einzeln und statisch aufzuführen.


Hier endet der Beitrag. Ich würde mich über Rückmeldung freuen, ganz egal ob über Anregungen, Hilfe oder einfach die Meldung, dass das jetzt zu aufwendig wäre umzuschreiben :)
Vielen Dank und ein schönes Wochenende,
Markus

Bild

Betrifft: AW: Code Optimierung
von: Markus
Geschrieben am: 31.07.2015 10:47:04
Ich habe mal eine Beispielmappe angefertigt und hoffe, dass mir nun Jemand weiterhelfen kann.
https://www.herber.de/bbs/user/99206.xlsm
Nochmals die Erklärung des Problems:
Beim Klick auf "Daten aufrufen" öffnet sich eine Liste mit den Kostenstellen (KS) zur Auswahl. Diese werden aus Spalte B ausgelesen, also schön dynamisch.
Anschließend wird beim Bestätigen der KS eine Funktion aufgerufen (einsehbar im Formular "AuswahlUserform"). Ich habe nur 3 KS in der Beispielmappe, da die Datei sonst zu groß für den Upload wäre. - Das bringt mich auch zum Teil des Problems.
Die aufgerufene Funktion ist in Modul 2 einsehbar und zeigt das ganze Grauen. Hier ist alles statisch auf jede einzelne KS angefertigt und funktioniert auch wunderbar. Allerdings sind es extrem viele Code Zeilen, die sich immer wieder wiederholen und nur die Zellenbezeichnung abgeändert wird.
Wünschenswert:
Das ganze soll kompakt und dynamisch sein, sodass ich in der "Leistungsübersicht" die Kostenstellen anpassen/ergänzen kann und dann dennoch die Daten aus "Daten" (hier muss dann natürlich entsprechen die KS angepasst werden) ausgelesen werden können.
Ich hoffe, damit ist das Problem gut beschrieben und ihr könnt mir jetzt weiterhelfen.
Über Hilfe wäre ich wirklich unendlich dankbar! Falls weitere Fragen offen sind, stellt sie bitte.
Vielen Dank,
Markus

Bild

Betrifft: AW: Code Optimierung
von: Markus
Geschrieben am: 31.07.2015 10:50:35
Und mal wieder vergessen, das Ganze offen zu lassen...

Bild

Betrifft: AW: Code Optimierung
von: Rudi Maintaire
Geschrieben am: 31.07.2015 12:41:07
Hallo,
nur mal kur drüber geschaut.
Für jedes Jahr eigener Code ist Quatsch. Den richtigen Bereich kannst du per Find-Methode ermitteln.
Gruß
Rudi

Bild

Betrifft: AW: Code Optimierung
von: Markus
Geschrieben am: 31.07.2015 12:50:22
Vielen Dank für die Rückmeldung Rudi,
dass das Quatsch ist, habe ich vermutet..aber wie beschrieben wusste ich mir leider nicht besser zu helfen und kann auch mit deiner Anregung, die Find-Methode zu benutzen, momentan noch nichts anfangen..
Liebe Grüße,
Markus

Bild

Betrifft: Find-Methode siehe Hilfe. owT
von: Rudi Maintaire
Geschrieben am: 31.07.2015 12:58:42


Bild

Betrifft: Expertenhilfe gefragt
von: Markus
Geschrieben am: 31.07.2015 13:29:08
Danke Rudi, gesucht habe ich bereits nach solchen Wegen.
Mein Problem ist die Umsetzung. Ich tue mir noch recht schwer mit den Basisanwendungen und benötige für so etwas leider noch eure Expertenhilfe, denn das übersteigt einfach meine Kenntnisse.
Ich wäre daher sehr froh, wenn sich jemand dem Thema annehmen könnte.
Vielen Dank und liebe Grüße,
Markus

Bild

Betrifft: Expertenhilfe für lau?
von: Michael
Geschrieben am: 02.08.2015 20:23:57
Hi Markus,
einige Vorschläge hätte ich da schon, aber meiner Meinung nach übersteigt das das, was man von einem Forum für lau erwarten kann.
Bislang habe ich rund 3 Stunden reingesteckt, um so weit zu kommen:
Userbild
Es werden alle Sachen angezeigt, die in der eingegebenen Zeile gefunden werden (Du siehst, daß ich ein paar weitere Spieldaten eingegeben habe), mit dem Schönheitsfehler, daß 50% als 0,5 ausgegeben wird. Das ist natürlich rein rechnerisch richtig und kann selbstverständlich umgangen werden.
Die Logik sollte denn sein, daß der Anwender nur die führende Nr. eingibt, und die gewählten Daten werden übertragen.
Man könnte auch hier ein weiteres Listenfeld nehmen, müßte dann aber die gefundenen Sachen irgendwo zwischenspeichern.
Geändert habe ich vorläufig nur das:

Option Explicit
Private Sub OKCommandButton_Click()
Dim c As Range
Dim a As Variant
Dim von&, bis&, zeile&, i&, j&, ausgabezeile&
Dim ausgabe As String, zwischenB1 As String, zwischenB2 As String, s As String
    ausgabezeile = 1
    von = 5
    bis = Worksheets("Daten").Range("A" & von).End(xlDown).Row
    Set c = Worksheets("Daten").Range("A" & von & ":A" & bis).Find(what:=KSAuswahlComboBox. _
Value)
    If Not c Is Nothing Then
        zeile = c.Row
        a = Worksheets("Daten").Range(Worksheets("Daten").Cells(zeile, 2), _
            Worksheets("Daten").Cells(zeile, 49))
        For i = 1 To 44 Step 6
          For j = 0 To 2
            zwischenB1 = zwischenB1 & a(1, i + 2 * j) & " "
            zwischenB2 = zwischenB2 & a(1, i + 2 * j + 1) & " "
          Next
          If Len(Trim(zwischenB1)) > 0 Then
            ausgabe = ausgabe & ausgabezeile & " ... " & _
              Worksheets("Daten").Cells(2, i + 1) & ": B1: " & zwischenB1 & vbLf
            ausgabezeile = ausgabezeile + 1
          End If
          If Len(Trim(zwischenB2)) > 0 Then
            ausgabe = ausgabe & ausgabezeile & " ... " & _
              Worksheets("Daten").Cells(2, i + 1) & ": B2: " & zwischenB2 & vbLf
            ausgabezeile = ausgabezeile + 1
          End If
          zwischenB1 = "": zwischenB2 = ""
        Next
        If Len(Trim(ausgabe)) = 0 Then ausgabe = "Keine Werte vorhanden"
        ausgabe = "Bitte wählen Sie: " & vbLf & _
                  "----------------- " & vbLf & ausgabe
        s = InputBox(ausgabe, "Eingabefeld für: " & "Mustermann")
      Else
        MsgBox "nicht gefunden"
        Exit Sub
    End If
    Unload Me
End Sub

Schöne Grüße,
Michael

Bild

Betrifft: AW: Expertenhilfe für lau?
von: Markus
Geschrieben am: 03.08.2015 08:24:00
Guten Morgen Michael,
leider kann ich auf Grund meiner bescheidenen Kenntnisse nicht abschätzen, wie viel Arbeit dahinter steckt. Dass Du dich da so reingehängt hast und so viel Zeit investiert hast, rechne ich Dir wirklich sehr hoch an und bin dir unendlich dankbar! :)
Und um nicht noch mehr Fragen zu stellen und Zeit von euch zu beanspruchen, werde ich mal versuchen, mit Deinem bearbeiteten Teil weiterzuarbeiten. Eventuell dauert es noch etwas, bis ich den Code komplett nachvollziehen kann, aber ich werde mein Bestes geben.
Ich danke Dir sehr und wünsche Dir einen guten Start in die neue Woche!
Liebe Grüße,
Markus

Bild

Betrifft: Schöpfungshöhe
von: Michael
Geschrieben am: 03.08.2015 17:06:32
Hallo Markus,
so wollte ich Dich denn auch nicht stehen lassen, weil mir relativ klar ist, daß es für Dich nicht einfach ist, die eigentlich bereits vorhandenen Infos sinnvoll "abzugreifen".
Und halbe Sachen mag ich auch nicht im Forum stehen haben.
Also: ich habe das Makro leicht geändert und gegen Ende aufgezeigt, in welchen Variabeln die Informationen stehen und wie Du sie ggf. in die Leistungsübersicht übernimmst. Ein Aufruf weiterer Funktionen ist dadurch mehr oder weniger überflüssig.
Zur Logik: ich wäre als Anwender binnen kürzester Zeit tierisch genervt, wenn ich Eingaben stückweise ("so, jetzt geben Sie mal das Jahr ein", "so, jetzt wählen Sie mal B1 oder B2") machen müßte, nur um dann zu erfahren, daß zu der Eingabe keine Daten vorhanden sind ("nee, is nich, probieren Sie es nochmal (händereib)").
Alles, was da ist, anzuzeigen und den Anwender daraus wählen zu lassen ist doch der deutlich benutzerfreundlichere Weg.
Bitte beachte auch das hinzugefügte Blatt "Checkboxen", in dem ich Dir aufzeige, wie Du mit den Checkboxen sinnvollerweise dynamisch umgehen kannst.
So, zuletzt noch die Datei: https://www.herber.de/bbs/user/99293.xlsm
Falls wir uns mal im Biergarten sehen, gibst a Schäuferla aus und 5 Maßen, gell!
Schöne Grüße,
Michael
P.S.: und 5 oder 6 Willi, dann paßt's.
P.P.S.: ach, das noch: ist es eigentlich Absicht, daß die Jahre 2013 und 2014 fehlen?!

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Zellennamen"