Gerne Testen

Moin,
dank des großartigen Support bin ich mit meiner kleinen Modul\Projektplanung erstmal fertig.
Die bed. Formatierung für händisch eingetragene M1-M11 und F in Y7:NZ106 fehlt noch, aber das ist kein großes Ding.
Sicher kann man das eine oder andere besser lösen und es ist nicht ausgeschlossen, dass im Laufe der Zeit Ideen oder Anforderungen hinzukommen.
Ich würde mich riesig freuen wenn der eine oder andere das Teil mal testet, unter die Lupe nimmt und mir gerne auch eine Rückmeldung gibt.

Bekannte "Probleme":
Dass die Sortierung beim Enddatum scheinbar rumzickt weiß ich und mit zwei Select Anweisungen (TN-Suche und Heute) bin ich noch nicht 100% zufrieden.
Bei Heute stört mich das Einrahmen (Selektieren des Datums), einfach "hinspringen" würde auch reichen.
Bei cmdBtn1_Click() würde ich c.Select gerne um die Range "B:X" oder gar "B:NX erweitern um den ganzen Bereich kenntlich zu machen.
Irgendwas zur besseren Orientierung halt. Muss natürlich aufgehoben werden, wenn die Textbox geleert wird.
Die Clear Anweisung hab ich aber noch nicht drin, ich bin froh, dass es bis dahin schon mal funktioniert.

https://www.herber.de/bbs/user/163638.xlsm

Zum Hintergrund:
Ich arbeite als Berater und Jobcoach für einen Bildungsträger in einem konzeptionell chaotischen Vergabeprojet der Arbeitsagentur.
Etwa eine Woche im Voraus werden uns TN zugewiesen, die dann jeweils Mittwochs starten.
Die Module 1 und 8 sind Pflichtmodule, alle weitern werden vom Arbeitsvermittler vorgeschlagen bzw. können sich die Teilnehmer frei aussuchen.
Einige Module haben eine unterschiedliche Dauer, Ausfalltage wegen Krankheit u.ä. müssen nachgeholt werden, so dass auch die Verweildauer sehr unterschiedlich sein kann.
Durch die unterschiedlichen Vorstellungen und Ansprüche ist es schwierig alle unter einen Hut zu bringen, zumal wir nur zu zweit sind und jeder am liebsten 6 Stunden am Tag Individualbetreuung hätte. Daher hatte ich vor ein paar Wochen die Idee zu dieser Modul\Projektplanung um Teilnehmer mit gleichen Modulen schon im Voraus besser zu Gruppen zusammenfassen zu können. Hinzu kommt, dass der Standort recht neu ist und wir derzeit nur einer Platzkapazität für max. 14 Teilnehmer vorhalten können.

Soviel erstmal....
Ich freu mich auf eure Rückmeldungen und ggf. Vorschläge.

Gruß, Nordic (Uwe)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Moin!

Ich schreib mal ein paar Sachen runter, die mir so auffallen. Kein Anspruch auf Vollständigkeit:

Wenn If -Bedingungen nur 1 ausführende Zeile haben, kann man sie in 1 Zeile schreiben.
With-Zusammenfassung ist auch nur sinnvoll, wenn sie nachfolgend mehrfach gebraucht wird

So wird aus

Private Sub cmdBtn1_Click()

    With Worksheets(1).Cells

        Set c = .Find(txtBox1.Value, LookIn:=xlValues)

        If Not c Is Nothing Then

            c.Select

        End If

    End With

End Sub

Private Sub cmdBtn1_Click()

    Set c = Worksheets(1).Cells.Find(txtBox1.Value, LookIn:=xlValues)

    If Not c Is Nothing Then c.Select

End Sub

hierzu

If tglBtn1 = True Then

Wenn eine Eigenschaft TRUE oder FALSE ist, dann ist doch ein Vergleich mit TRUE oder FALSE überflüssig. Selbst das umkehren könnte man mit NOT(Eigenschaft) abfragen.

Daher wird aus

Private Sub tglBtn1_Click()

    With tglBtn1

         .BackColor = IIf(.Value = False, &H80000002, &H80000002)

    End With



    If tglBtn1 = True Then

            Columns("D:G").EntireColumn.Hidden = False

        Else

            Columns("D:G").EntireColumn.Hidden = True

    End If

End Sub

Private Sub tglBtn1_Click()
With tglBtn1
.BackColor = IIf(Not (.Value), &H80000002, &H80000002)
Columns("D:G").EntireColumn.Hidden = Not (.Value)
End With
End Sub

Da diese Knöppe aber 6x in dieser Weise angesprochen werden würde ich mir eine Sub bauen, die mehr Übersicht bringt.
Das sieht dann so aus:

Private Sub tglBtn1_Click()

    Bereich_Blende tglBtn1, Columns("D:G")

End Sub



Private Sub tglBtn2_Click()

    Bereich_Blende tglBtn2, Columns("I:S")

End Sub



Private Sub tglBtn3_Click()

    Bereich_Blende tglBtn3, Columns("Y:DJ")

End Sub



Private Sub tglBtn4_Click()

    Bereich_Blende tglBtn4, Columns("DK:GW")

End Sub



Private Sub tglBtn5_Click()

    Bereich_Blende tglBtn5, Columns("GX:KK")

End Sub



Private Sub tglBtn6_Click()

    Bereich_Blende tglBtn6, Columns("KL:NZ")

End Sub



Sub Bereich_Blende(btn As Object, Bereich As Range)

    

    With btn

         .BackColor = IIf(Not (.Value), &H80000002, &H80000002)

         Bereich.EntireColumn.Hidden = Not (.Value)

    End With

    

End Sub

Den Fehler der Range schmeiss ich raus, aber select will auch keiner. Dafür bringen wird Übersicht in die Sortier-Parameter

Aus

Sub SortStart()



If ActiveSheet.Shapes("Sort 1").ControlFormat.Value = 1 Then

    Direction = xlAscending

Else

    Direction = xlDescending

End If



Application.ScreenUpdating = False

'ActiveSheet.Unprotect "123"

Range("C7:X106" & gLR).Select

    Selection.Sort Key1:=Range("H6"), Order1:=Direction, Header:=xlGuess, _

        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _

        DataOption1:=xlSortNormal

'ActiveSheet.Protect "123we"

Application.ScreenUpdating = True

Range("C" & gLR + 1).Select

End Sub

wir dann (beide Codes)

Sub SortStart()

    

    If ActiveSheet.Shapes("Sort 1").ControlFormat.Value = 1 Then

        Direction = xlAscending

    Else

        Direction = xlDescending

    End If

    

    Application.ScreenUpdating = False

    'ActiveSheet.Unprotect "123"

    Range("C7:X106").Sort Key1:=Range("H6"), _

                            Order1:=Direction, _

                            Header:=xlGuess, _

                            OrderCustom:=1, _

                            MatchCase:=False, _

                            Orientation:=xlTopToBottom, _

                            DataOption1:=xlSortNormal

    'ActiveSheet.Protect "123we"

    Application.ScreenUpdating = True

    Range("C" & gLR + 1).Select

End Sub



Sub SortEnd()

    

    If ActiveSheet.Shapes("Sort 2").ControlFormat.Value = 1 Then

        Direction = xlAscending

    Else

        Direction = xlDescending

    End If

    

    Application.ScreenUpdating = False

    'ActiveSheet.Unprotect "123"

    Range("C7:X106").Sort Key1:=Range("V6"), _

                            Order1:=Direction, _

                            Header:=xlGuess, _

                            OrderCustom:=1, _

                            MatchCase:=False, _

                            Orientation:=xlTopToBottom, _

                            DataOption1:=xlSortNormal

    'ActiveSheet.Protect "123"

    Application.ScreenUpdating = True

    Range("C107).Select

End Sub

Die Sortierungen stimmen soweit bei mir , da rutscht nix runter.

Schau mal, wie du damit klarkommst.

Gurß, MCO

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Gerne Testen

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread