Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen

Combobox_ 2 SPalten_o.Dup_sortiert

Betrifft: Combobox_ 2 SPalten_o.Dup_sortiert von: Jack_d
Geschrieben am: 28.07.2014 13:24:48

Hallo Gemeinde

nach längerer Abstinenz hätte ich mal ein Anliegen.

Und zwar versuche ich aktuell eine CB in einer Userform mit Werten zu füllen.

1. Die Werte sind in einem Tabellenblatt auf 2 Spalten verteilt
(1. Spalte Numerische Beschreibung ; 2. Spalte Alphanumerische Beschreibung )
2. Sie sind im Sinne einer Datenbank immer eineindeutig

Private Sub UserForm_Initialize()
Dim oDic As Object, meAr
Dim A As Long

Set oDic = CreateObject("Scripting.Dictionary")

With Sheets("Master")
    
    meAr = Range("D2", .Cells(.Rows.Count, 5).End(xlUp))
End With

For A = 1 To UBound(meAr)
  oDic(meAr(A, 1)) = 0
Next

HFA_KORR.CB_HFA.List = oDic.keys

End Sub
Folgender Code liest mir ja schonmal die 1. Spalte ein und korriegiert sich mir um die Dubletten.

WAs fehlt, ist die 2. Spalte (Ich glaub hier liegt die Ursache im Dict)

Was ich auch noch nicht hab umsetzten können ist eine Sortierung innerhalb des Dicts

Vielleicht weiss ja jemand Rat.
Anbei zur unterstützung mal eine Mustermappe
https://www.herber.de/bbs/user/91756.xlsm

Vielen Dank für eure Unterstützung

  

Betrifft: AW: Combobox_ 2 SPalten_o.Dup_sortiert von: Daniel
Geschrieben am: 28.07.2014 13:42:34

Hi

nutze die Excelfunktionen fürs Sortieren und Duplikate entfernen.
hierzu kopierst du erstmal die Tabelle an eine freie Stelle der Tabelle und bearbeitest die dort entsprechend, bevor du sie in die Combobox liest.
Da es hier eine zweispaltige Liste ist, musst du für die Combobox die entsprechenden Eigenschaften einstellen (Anzahl Spalten, Spaltenbreite in der Liste).
Diese Einstellungen kannst du wie gezeigt per Code machen oder du kannst sie direkt in der Eigenschaftsliste einstellen.

im Textfeld der Combobox kann immer nur der Wert einer Spalte angezeigt werden!

Private Sub UserForm_Initialize()
With CB_HFA
    .ColumnCount = 2
    .ColumnWidths = "40;50"
End With
    
With Sheets("Master")
    .Range(.Cells(2, 4), .Cells(1, 4).End(xlDown).Offset(0, 1)).Copy
    .Cells(1, 26).PasteSpecial xlPasteValuesAndNumberFormats
    With .Columns(26).Resize(, 2)
        .Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlNo
        .RemoveDuplicates 1, xlNo
        CB_HFA.List = .CurrentRegion.Value
        .ClearContents
    End With
End With
End Sub
Gruß Daniel


  

Betrifft: AW: Combobox_ 2 SPalten_o.Dup_sortiert von: Jack_d
Geschrieben am: 28.07.2014 13:52:44

Hallo Daniel

vielen DAnk für deine Mühe.
Und ja, du hast recht, das ist eine Möglichkeit das ganze Abzubilden. Aber irgendwie find ich die Lösung nicht "schön"

Gibt es denn eine Array / Dict basierende Lösung?

Grüße


  

Betrifft: AW: Combobox_ 2 SPalten_o.Dup_sortiert von: Daniel
Geschrieben am: 28.07.2014 14:12:13

du musst in die Items des Dictionarys den Wert aus der zweiten Spalte schreiben.

beim übernehmen in die Liste der Combobox musst du dann in einer Schleife über alle Werte des Dictionarys gehen und für die Liste per .AddItem eine neue Datenzeile hinzufügen.
Den jeweiligen Key schreibst du in die erste Spalte und das dazugehörige Item in die zweite.

damit es sortiert wird, musst du die jeweils vorhandene Liste erstmal in einer Schleife vom ersten bis zum letzen vorhandenen Element durchlaufen, die Werte vergleichen und so entscheiden, an welcher Position der neue Wert eingefügt werden muss.

wenn du das schöner findest, kannst du es gerne selbst programmieren, ich finde meine Lösung einfacher, praktischer und vorallem für Programmieranfänger leichter verständlich.
Ausserdem ist es auch für mich als Programmierer leichter, diesen Code zu testen, weil keine Schleifen vorhanden sind, welche bei Durchlauftest im Einzelstep einfach lästig sind.

Gruß Daniel


  

Betrifft: AW: Combobox_ 2 SPalten_o.Dup_sortiert von: Jack_d
Geschrieben am: 28.07.2014 14:27:12

Hallo Daniel

vielen Dank nochmals für dein Engagement.
Und ich gebe dir recht, dass deine Lösung programmtechnisch einfacher zu erstellen ist.

Nichtsdestotrotz würde ich mich dann auf Rudis Lösungsansatz berufen. (weil, auch wenns doof klingt, der für mich schöner ist)

Grüße


  

Betrifft: AW: Combobox_ 2 SPalten_o.Dup_sortiert von: Daniel
Geschrieben am: 28.07.2014 14:32:37

dann lass mal ein halbes Jahr ins land gehen, schaue dir danach den Code an und versuche herauszufinden, wofür dieser Code gut ist und was er macht, falls die Dokumentation inzwischen verloren gegangen sein solle.
Ich gehe mal bei meinem Code davon aus, dass durch die Schlüsselwörter ".Sort" und ".Removeduplicates" auch ohne weitere Dokumentation schnell klar wird, was hier passiert.

ansonsten, könntest du für mich mal begründen, was für dich die "Schönheit" eines Codes ausmacht?
vielleicht kann ich dann in zukunft Fragenden wie dir besser helfen.

Gruß Daniel


  

Betrifft: AW: Combobox_ 2 SPalten_o.Dup_sortiert von: Jack_d
Geschrieben am: 28.07.2014 14:51:19

Hallo Daniel

dann lass mal ein halbes Jahr ins land gehen, schaue dir danach den Code an und versuche herauszufinden, wofür dieser Code gut ist und was er macht, falls die Dokumentation inzwischen verloren gegangen sein solle.

Das Problem hatte ich schon mehr als einmal. Daher hab ich mir angewöhnt den Code immer gleich zu Kommentieren (innerhalb des Codes)
ansonsten, könntest du für mich mal begründen, was für dich die "Schönheit" eines Codes  _
ausmacht?
vielleicht kann ich dann in zukunft Fragenden wie dir besser helfen.

Kann ich dir gern begründen.

1. Ich hab es bewusst in Gänsefüßchen gesetzt, da mir schon klar ist, dass das ein reiner Spleen von mir ist.

2. hab ich in meinen Anfängen eben sehr viel über kopieren - auslagern(in andere Blätter) - zurückholen etc. gemacht. das in Verbindung mit select, activate und weiss der Geier noch allem hat die Performance und nicht zuletzt auch die Optik der Makroausführung negativ beeinflusst.

3. Bin ich durch die ganzen Spezis (hier) zu Arrays und Dicts gekommen, die die Dinge eben mal so im Hintergrund "abwickeln" -> das Empfinde ich als schöner
Und ja mir ist durchaus die Möglichkeit des ausschaltens des Screenupdatings bewusst.

Ich hoffe dir mit meiner Ausführung meine Sichtweise auf die Dinge plausibel gemacht zu haben. Wohl wissend, dass es andere (wichtigere) Motivanzen geben kann den Code anders abzubilden.
Desweiteren möchte ich dass du weisst das es sicherlich nicht als Affront gegen dich gedacht war /ist, deinen Code als "unschön" abzutun. Ich möchte hier explizit auf meine Macke hinweisen

Grüße


  

Betrifft: AW: Combobox_ 2 SPalten_o.Dup_sortiert von: Daniel
Geschrieben am: 28.07.2014 15:04:14

Warum hast du mit Selects und Activats programmiert?
Das ist überflüssig und unnötig.
Wenn du bspw die Daten auf ein anderes Tabellenblatt auslagerst und dann dieses Blatt ausblendest, dann flackert da nichts und du brauchst auch nicht die Bildschirmaktualisierung auszuschalten.
Gruß Daniel


  

Betrifft: AW: Combobox_ 2 SPalten_o.Dup_sortiert von: Jack_d
Geschrieben am: 28.07.2014 15:16:02

Warum hast du mit Selects und Activats programmiert?
Das ist überflüssig und unnötig.

Das weiß man mit dem Abstand von 4 Jahren dann auch =)
Ich hab so mit VBA angefangen wie es vermutlich 90% der nichtinformatiker machen. Makro aufzeichen, anpassen und ausbauen. Und der Rekorder nimmt nunmal sehr gern die o.g. Befehle
Wenn man dann mit rudimentären Kentnissen daraufhin ein Projekt aufbaut, was mehr und mehr wächst, und weitere Anforderungen hinzukommen, und man sich natürlich auch weiter entwickelt, kommt man irgendwann an den Punkt an dem man alles auf Null setzt und den Code "lege artis" (aus Nichtinformatikersicht) neu schreibt.
Wenn du bspw die Daten auf ein anderes Tabellenblatt auslagerst und dann dieses Blatt ausblendest, dann flackert da nichts und du brauchst auch nicht die Bildschirmaktualisierung auszuschalten.

Stimmt, ist auch eine Möglichkeit.
Allerdings ist das hier erörterte Snippet ein Teil eines Größeren Projektes welches als (Ribbon-) Addin konstruiert ist. Was wiederum zur Folge hat, dass ich ungern unnötige Tabellen mit mir "rumschleppe"
Für den Fall müsste ich also wieder ein Blatt erstellen - Ausblenden - löschen
Oder aber screenupdating ausschalten.

Insofern ja, viele Wege führen nach Rom. ob man nun aber über Paris, Bern oder Timbuktu wie in meinem Fall das muss jeder selbst entscheiden (dürfen)

Grüße


  

Betrifft: "schöne" Lösung von: Rudi Maintaire
Geschrieben am: 28.07.2014 14:13:45

Hallo,

Private Sub UserForm_Initialize()
  Dim oDic As Object, meAr
  Dim A As Long
  Dim arrTmp, arrErg(), Tmp
  Dim x As Long, y As Long
  
  Set oDic = CreateObject("Scripting.Dictionary")
  
  With Sheets("Master")
    meAr = .Range("D2", .Cells(.Rows.Count, 5).End(xlUp))
  End With
  
  For A = 1 To UBound(meAr)
    oDic(meAr(A, 1)) = meAr(A, 2)
  Next
  
  arrTmp = oDic.keys
  For x = 0 To UBound(arrTmp) - 1
    For y = x + 1 To UBound(arrTmp)
      If arrTmp(y) < arrTmp(x) Then
        Tmp = arrTmp(x)
        arrTmp(x) = arrTmp(y)
        arrTmp(y) = Tmp
      End If
    Next
  Next
  
  ReDim arrErg(1 To oDic.Count, 1 To 2)
  For x = 0 To UBound(arrTmp)
    arrErg(x + 1, 1) = Format(arrTmp(x), "0000")
    arrErg(x + 1, 2) = oDic(arrTmp(x))
  Next
  
  With UserForm1.CB_HFA
    .ColumnCount = 2
    .List = arrErg
  End With
  
End Sub

Gruß
Rudi


  

Betrifft: Perfekt Rudi von: Jack_d
Geschrieben am: 28.07.2014 14:23:33

vielen Lieben Dank


  

Betrifft: AW: Combobox_ 2 SPalten_o.Dup_sortiert von: fcs
Geschrieben am: 28.07.2014 14:57:05

Hallo Jack,

über zusätzliche Hilfarays kann man das ganze schaffen. Zusätzlich braucht es eine Sortierroutine.

Gruß
Franz

Private Sub UserForm_Initialize()
  Dim oDic As Object, meAr, meA2, meAr3, meListe()
  Dim A As Long
  Dim Zeile As Variant
  Set oDic = CreateObject("Scripting.Dictionary")
  
  With Sheets("Master")
      
      meAr = Range("D2", .Cells(.Rows.Count, 5).End(xlUp)) 'HA_301,HFA-Name
      meAr3 = Range("D2", .Cells(.Rows.Count, 4).End(xlUp)) 'HFA-Name
      For A = 1 To UBound(meAr)
        oDic(meAr(A, 1)) = 0
      Next
      'Schlüssel Array zuweisen
      meAr2 = oDic.keys
      'Array sortieren
      Call QuickSort(DasArray:=meAr2)
      'zu Schlüsselnummern die Texte ermitteln und alles in Array sammeln
      ReDim meListe(LBound(meAr2) To UBound(meAr2), 1 To 2)
      For A = LBound(meAr2) To UBound(meAr2)
        Zeile = Application.Match(meAr2(A), meAr3, 0)
        meListe(A, 1) = Format(meAr(Zeile, 1), "0000")
        meListe(A, 2) = meAr(Zeile, 2)
      Next
      UserForm1.CB_HFA.List = meListe
      'Alles Array leeren
      Erase meAr, meAr3, meAr2, meListe
      Set oDic = Nothing
  End With
  

End Sub



'Code in einem allgemeinen Modul
'Quelle für QuickSort: _
'https://www.herber.de/forum/archiv/1264to1268/1267925_Werte_in_einer_einzelnen_Zelle_sortieren. _
html#1268063
'Option Compare Text 'ggf. Setzen - Groß-/Kleinschreibung wird beim sortieren ignoriert.
Public Sub QuickSort(ByRef DasArray, Optional ErsteZeile = -1, Optional LetzteZeile = -1)
    'Sortiert ein einspaltiges Daten-Array
    Dim UnterGrenze As Long, OberGrenze As Long
    Dim AktuellerWert, GemerkterWert As Variant, tmpWert As Variant
    
    If ErsteZeile < 0 Then ErsteZeile = LBound(DasArray)
    If LetzteZeile < 0 Then LetzteZeile = UBound(DasArray)
    
    UnterGrenze = ErsteZeile
    OberGrenze = LetzteZeile
    AktuellerWert = DasArray((ErsteZeile + LetzteZeile) \ 2)
    
    Do While (UnterGrenze <= OberGrenze)
        Do While (DasArray(UnterGrenze) < AktuellerWert And UnterGrenze < LetzteZeile)
            UnterGrenze = UnterGrenze + 1
        Loop
        Do While (DasArray(OberGrenze) > AktuellerWert And OberGrenze > ErsteZeile)
            OberGrenze = OberGrenze - 1
        Loop
        
        If (UnterGrenze <= OberGrenze) Then
            GemerkterWert = DasArray(UnterGrenze)
            DasArray(UnterGrenze) = DasArray(OberGrenze)
            DasArray(OberGrenze) = GemerkterWert
            UnterGrenze = UnterGrenze + 1
            OberGrenze = OberGrenze - 1
        End If
    Loop
    
    If (OberGrenze > ErsteZeile) Then Call QuickSort(DasArray, ErsteZeile, OberGrenze)
    If (UnterGrenze < LetzteZeile) Then Call QuickSort(DasArray, UnterGrenze, LetzteZeile)
End Sub



  

Betrifft: AW: Combobox_ 2 SPalten_o.Dup_sortiert von: Jack_d
Geschrieben am: 28.07.2014 15:49:04

Hallo Franz

vielen Dank auch für deine Lösung. Funktioniert auch klaglos.

Nur leider ist Rudi um 0,004 Sekunden schneller :-D .. akademisch =)
Wobei die Auslagerung der Sort() in ein Modul auch seinen charme hat

Grüße


  

Betrifft: AW: Combobox_ 2 SPalten_o.Dup_sortiert von: Rudi Maintaire
Geschrieben am: 28.07.2014 16:15:04

Hallo,
noch einen Tick schneller sollte es so gehen:

Private Sub UserForm_Initialize()
   Dim oDic As Object, meAr
   Dim A As Long
   Dim arrTmp, arrErg(), Tmp
   Dim x As Long, y As Long
   
   Set oDic = CreateObject("Scripting.Dictionary")
   
   With Sheets("Master")
     meAr = .Range("D2", .Cells(.Rows.Count, 5).End(xlUp))
   End With
   
   For A = 1 To UBound(meAr)
     oDic(meAr(A, 1)) = meAr(A, 2)
   Next
   
   arrTmp = oDic.keys
   QuickSort arrTmp
   
   ReDim arrErg(1 To oDic.Count, 1 To 2)
   For x = 0 To UBound(arrTmp)
     arrErg(x + 1, 1) = Format(arrTmp(x), "0000")
     arrErg(x + 1, 2) = oDic(arrTmp(x))
   Next
   
   With UserForm1.CB_HFA
     .ColumnCount = 2
     .List = arrErg
   End With
   
 End Sub

QuickSort wie von Franz gepostet.

Gruß
Rudi


  

Betrifft: and the winner is .. von: Jack_d
Geschrieben am: 29.07.2014 09:05:54

Franz und Rudi

in der Kombination der Makros konnten nochmal 0,006 Sekunden gespart werden =)
Und diese riesen Zeitdifferenz war schon wichtig zu identifizieren =)

Eine Frage hätt ich allerdings noch.

Und zwar bei der ersten Ausführung des Makros war es "wesentlich" langsamer (fast doppelt so lange Laufzeit) die sich bei jedem Durchlauf weiter reduziert hat. Woran liegt das?

Grundvorraussetzungen: gleicher Datensatz; keine Aktive Änderung an anderen Programmen?

Add.: hab es nach dem schreiben des Textes hab ich es nochmal "gemacht" und wieder mit dem gleichen Effekt die Laufzeit wird immer mehr reduziert (wieder bis auf das o.g. Minimum)

Grüße und vielen Dank


  

Betrifft: AW: and the winner is .. von: fcs
Geschrieben am: 30.07.2014 02:27:41

Hallo Jack,

der Grund für die längere Laufzeit beim 1. Aufrufe des Userforms könnte sein:

Das Userform wird nach dem 1. Aufruf beim Schließen nicht mit Unload aus dem Arbeitsspeicher gelöscht, sondern mit der Hide-Methode nur ausgeblendet. Die zusätzliche Zeit beim 1. Aufruf ist dann für die Initialisierungs-Prozedur und das Laden des Userforms erforderlich.
Die weiteren leichten Verbesserungen der Laufzeit sind dann wahrscheinlich auf eine Optimierung beim Zugriff auf im Arbeitsspeicher bereits vorhandene Daten zurückzuführen.

Erst mit dem Schließen der Datei verschwindet das Userform aus dem Arbeitsspeicher und nach erneutem Öffnen der Datei tritt der Effekt dann wieder auf.

Gruß
Franz


  

Betrifft: AW: and the winner is .. von: Jack_d
Geschrieben am: 30.07.2014 08:36:12

Hallo Franz

vielen Dank für deinen Tip.

Klingt nachvollziehbar. Auch wenn der Effekt auch beim "warten" auftritt. D.h. Datei ist offen, wird nur nicht genutzt. Ich unterstelle hier einfach mal eine kurzlebigkeit der im RAM ausgelagerten Dateien.

Grüße


  

Betrifft: AW: noch ne schöne Lösung von: Daniel
Geschrieben am: 28.07.2014 15:28:23

und benötigt nicht mal Dictionarys.

schön kurz, aber trotzdem sortiert und ohne Duplikate.
(obs allerdings bei grossen Datenmengen schnell genug ist, müsstest du mal testen)

Private Sub UserForm_Initialize()
Dim i As Long, z As Long
Dim arr
arr = Sheets("Master").Cells(1, 4).CurrentRegion.Value

With CB_HFA
    .ColumnCount = 2
    .ColumnWidths = "40;50"
    
    For z = 2 To UBound(arr, 1)
        arr(z, 1) = Format(arr(z, 1), "0000")
        For i = 0 To .ListCount - 1
            If arr(z, 1) <= .List(i, 0) Then Exit For
        Next
        If i = .ListCount Then
            .AddItem arr(z, 1)
            .List(.ListCount - 1, 1) = arr(z, 2)
        Else
            If .List(i, 0) <> Format(arr(z, 1), "0000") Then
                .AddItem arr(z, 1), i
                .List(i, 1) = arr(z, 2)
            End If
        End If
    Next
End With
End Sub
Gruß Daniel


  

Betrifft: AW: noch ne schöne Lösung von: Jack_d
Geschrieben am: 28.07.2014 15:45:42

Hallo Daniel

Also ja, ist auch ne Möglichkeit und sieht auch ganz elegant aus.

Aber ist mit 0,25 Sekunden bei 13.500 im vergleich zu "Rudis" 0,015 Sekunden vergleichsweise langsam.

Vielen dank dennoch

Grüße


  

Betrifft: AW: noch ne schöne Lösung von: Daniel
Geschrieben am: 28.07.2014 15:49:32

du solltest vielleicht schon zu Anfang ein paar Angaben über dein Projekt machen, dann weiss man besser, welche Lösungen auf grund der Datenmenge herausfallen!
Gruß Daniel


 

Beiträge aus den Excel-Beispielen zum Thema "Combobox_ 2 SPalten_o.Dup_sortiert"