Thema Datum  Von Nutzer Rating
Antwort
02.06.2016 11:14:41 David
Solved
02.06.2016 14:09:06 Gast22981
NotSolved
02.06.2016 14:28:08 David
NotSolved
02.06.2016 14:54:25 Gast49737
NotSolved
02.06.2016 15:20:03 David
NotSolved
02.06.2016 16:09:27 Gast18220
NotSolved
02.06.2016 16:30:55 David
NotSolved
02.06.2016 18:48:44 Gast70202
NotSolved
02.06.2016 19:02:30 David
NotSolved
02.06.2016 19:43:31 Gast83713
NotSolved
02.06.2016 19:52:34 David
NotSolved
02.06.2016 20:02:48 David
NotSolved
02.06.2016 20:03:22 Gast24976
NotSolved
02.06.2016 20:02:51 Gast83147
NotSolved
02.06.2016 20:23:31 David
NotSolved
02.06.2016 21:26:15 Gast86243
NotSolved
02.06.2016 22:25:52 David
NotSolved
02.06.2016 22:31:07 David
NotSolved
Rot Dropdown-Auswahlliste Makro / Formel?
03.06.2016 09:54:26 Gast50518
NotSolved
03.06.2016 10:36:01 David
NotSolved
03.06.2016 18:04:44 David
NotSolved
03.06.2016 19:35:45 Gast52557
NotSolved
03.06.2016 22:09:28 Gast87028
NotSolved
03.06.2016 22:31:51 Gast22731
NotSolved
03.06.2016 22:43:32 Gast72656
NotSolved
04.06.2016 09:02:30 Gast97636
NotSolved
04.06.2016 13:10:06 Gast88175
NotSolved
02.06.2016 19:03:29 David
NotSolved

Ansicht des Beitrags:
Von:
Gast50518
Datum:
03.06.2016 09:54:26
Views:
537
Rating: Antwort:
  Ja
Thema:
Dropdown-Auswahlliste Makro / Formel?

Das Forum ist für zuviel Dank gesperrt1. :-D

Also hier was mit Kommentaren. Da ich nicht wußte, wie fit du in VBA bist habe ich mal alles kommentiert. Also deshalb nicht wundern / böse sein. Die Teile die du kennst, einfach überspringen. In der Funktion habe ich die Variablennamen nochmal geändert . Wenn Fragen sind, einfach nochmal antworten. VG

 

Sub gütligkeit()
Dim gültigliste As String
Dim i As Long
Dim letzte As Long
     
With Sheets("Analysedaten")
'Anfangswert der Liste, "," ist nötig um jeden Wert mit Kommas eingeschlossen zuhaben, so kann man vermeiden, dass man bei der
' Suche, ob der Wert schon da ist bspw. 2 auch in 32 findet - womit die Zahl nicht aufgenommen würde
gültigliste = ","
'soll ausschließlich nur SPALTE A betrachten
'letzer Eintrag in Spalte A
letzte = .Cells(Rows.Count, 1).End(xlUp).Row
'alle Zeilen in Spalte A ab Zeiel 2 durchgehen
For i = 2 To letzte
    'wenn der WErt nicht leer ist und es sich um eine Zahl handel - IsNumeric -, weiterprüfen
    If .Cells(i, 1) <> "" And IsNumeric(.Cells(i, 1)) Then
        'die Werte werden in einem String aneinandergereit. jeder Wert ist von Kommas eingeschlossen,
        'deshalb mit instr prüfen ob es das Gebilde ,ZellWert, gibt. Wenn es da gibt, wird die Stelle im String angezeigt
        ' ist der Wert > 0 würde der Eintrag dort beginng, bei 0 wurde er nicht gefunden
        ' wenn also 0 dan eintragen. Dazu ans Ende des String packen und mit einem "," abschließen, um den WErt eindeutig zu finden
        If InStr(1, gültigliste, "," & .Cells(i, 1) & ",", vbTextCompare) = 0 Then gültigliste = gültigliste & CLng(.Cells(i, 1)) & ","
    End If
Next i
   
End With
  
'wenn nur eine Komma drin ist, wurde nichts gefunden, ergänzt dann nix machen
If gültigliste <> "," Then
    'die Liste beginnt mit "," und endet mit ",", die wieder wegmachen, als nur den String ab Stelle 2 bis vorletzte Stelle (Länge -ersten - letzen = Lönge -2) kopieren
    
    gültigliste = Mid(gültigliste, 2, Len(gültigliste) - 2)
       
    'die LIste so jetzt über einen Algorithmus sorteieren lassen, dazu wird er an die Funktion übergeben und kommt sortiert zurück
    gültigliste = BubbleSort(gültigliste)
    'nun die alte Gültigkeit löschen und die neue einfügen
    With Sheets("Tabelle2").Range("G5").Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=gültigliste
    End With
        
End If
End Sub
' das ist einer von vielen Sortieralgorythmen, ggf. mal im Internet schauen, gibt auch noch andere und schnellere, für deinen Zweck reicht der aber aus
' Bei Bubblesort wird eine Array mit Wert sortiert. Dabei werden immer zwei benachbarte Arrayglieder verglichen und wenn der erste größer ist vertausch.
' Das ganze läuft in vielen Schleifen, bis bei einem Durchgang kein Vertauschung mehr notwendig war - ergo die Liste sortiert ist.
Function BubbleSort(Liste As Variant)
    Dim i As Long, stellen As Long, Temp As Long
    Dim sortiert As Boolean
    Dim Listearray
    
    'habe die Namen nochmal geändert, um es verständliche rzu amchen
    'zu Anfang wird die übergebene Liste in ein Array aufgesplittet, die Liste kommt aus dem Funktinsnamen und ist der Wert den wir da oben übergeben haben
    ' das aufsaplten passiert an den Stellen, wo ein Komma ist
    Listearray = Split(Liste, ",")
    ' schauen, wie wiele Glieder es dann im Array gibt
    stellen = UBound(Listearray)
    ' jetzt mit einer Schleife durchgehen, do loop hat untenbei until ein Abbruchkriterium - sortiert ist wahr, es werden erst die Anweisungen nach dem do
    ' ausgeführt und dann sortiert geprüft, ist sortiert falsch, werden die Anweisungen nochmal durchgeführt, so lange bis sortiert wahr ist
    Do
        ' anfangs das Abbruchkriterium auf wahr setzen, wird nur, wenn wir Stellen vertauschen wieder auf nein gesetzt
        sortiert = True
        ' jetzt in einer for schleife die Elemente vergleichen. Ein array starte beim Index 0 deshalb bei 0 beginnen. Vergleich bis 1 Stelle weniger als die
        ' Gesamtstellenzahl. Man braucht ja nur soviel Vergleiche wie "Lücken" zwischen den Werten sind. bspw. 2 3 4 , sind 3 zahlen aber nur 2 Lücken also 2 Vergleiche
        For i = 0 To stellen - 1
            ' jetzt zwei aufeinanderfolgende Elemente vergleichen, Clng interpretiert das als Zahl vom Typ long, wenn nicht wird die Liste als String (ist ja einer)
            'interpretiert und es kommt die verquere Sortierung wie beim ersten post
            If CLng(Listearray(i)) > CLng(Listearray(i + 1)) Then
                ' wenn der Wert größer ist tuaschen, dazu erst die erste Zelle in einem Temp Variable schreiben,
                Temp = CLng(Listearray(i))
                ' dann den Wert von der zweiten Zellen in die erste Zellen
                Listearray(i) = CLng(Listearray(i + 1))
                ' in die zweite Zelle den wert aus Temp
                Listearray(i + 1) = Temp
                ' jetzt sind die Werte getauscht, und da was getauscht wurden, das Abbruchkriterium auf falsch setzen, könne ja noch was zu, Sortieren geben
                sortiert = False
            End If
        Next i
        'jetzt prfen und entweder beenden oder nochmal schauen
        ' bei einem Durchlauf wo nix mehr vertauscht wurde, bleibt sortiert wahr und damit bricht die Schleife ab
    Loop Until sortiert
    ' jetzt wieder das Array als Liste zusammenpacken, dazu die einzelnen Elemente mit einem Komma verketten - braucht die Gültigkeit ja so.
    ergebnis = Join(Listearray, ",")
    ' nun haben wir wieder unsere Liste aber sortiert, die geben wir an das aufrufende Programm zurück
    BubbleSort = ergebnis
End Function

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
02.06.2016 11:14:41 David
Solved
02.06.2016 14:09:06 Gast22981
NotSolved
02.06.2016 14:28:08 David
NotSolved
02.06.2016 14:54:25 Gast49737
NotSolved
02.06.2016 15:20:03 David
NotSolved
02.06.2016 16:09:27 Gast18220
NotSolved
02.06.2016 16:30:55 David
NotSolved
02.06.2016 18:48:44 Gast70202
NotSolved
02.06.2016 19:02:30 David
NotSolved
02.06.2016 19:43:31 Gast83713
NotSolved
02.06.2016 19:52:34 David
NotSolved
02.06.2016 20:02:48 David
NotSolved
02.06.2016 20:03:22 Gast24976
NotSolved
02.06.2016 20:02:51 Gast83147
NotSolved
02.06.2016 20:23:31 David
NotSolved
02.06.2016 21:26:15 Gast86243
NotSolved
02.06.2016 22:25:52 David
NotSolved
02.06.2016 22:31:07 David
NotSolved
Rot Dropdown-Auswahlliste Makro / Formel?
03.06.2016 09:54:26 Gast50518
NotSolved
03.06.2016 10:36:01 David
NotSolved
03.06.2016 18:04:44 David
NotSolved
03.06.2016 19:35:45 Gast52557
NotSolved
03.06.2016 22:09:28 Gast87028
NotSolved
03.06.2016 22:31:51 Gast22731
NotSolved
03.06.2016 22:43:32 Gast72656
NotSolved
04.06.2016 09:02:30 Gast97636
NotSolved
04.06.2016 13:10:06 Gast88175
NotSolved
02.06.2016 19:03:29 David
NotSolved