Helpmij.nl
Helpmij.nl
Helpmij.nl
Steun Helpmij.nl! Klik hier     Computerprobleem? Klik hier!

Quote

Weergeven resultaten 1 tot 15 van 15

Onderwerp: Listbox in combinatie met AANTAL in kolom 2

  1. #1
    Vraag is opgelost

    Listbox in combinatie met AANTAL in kolom 2

    Beste VBA'ers

    Ik heb een macro gemaakt welke via een ListBox een overzicht geeft van de klanten die een bestelling hebben gedaan. Deze tool werkt op zich prima. Ik kan (een) klant(en) selecteren en de macro gaat ermee aan de gang.

    De data in dit voorbeeld bestand wordt telkens aangevuld. (normaliter draait deze macro los van het data bestand)

    Ik heb een deel van initialisatie even uit de totale macro gehaald om het overzichtelijker te maken.

    Dit gedeelte van de code doet het volgende:

    Leest de waarde uit kolom 5 en vult dan de ListBox met UNIEKE waarden (het kolom nummer is in de code aan te passen).

    Ik zou graag willen dat in kolom 2, van ListBox, het aantal bestelde regels zichtbaar wordt (AANTAL.ALS gebaseerd op waarde kolom 5) en deze kolom word gesorteerd (hoog/laag). Dan kan ik besluiten om de klant met de meeste regels af te drukken of nog even te wachten tot er meer regels bij zijn gekomen.

    Let op ! bij het openen van het bestand wordt een invoegtoepassing aangemaakt genaamd "Picklist Tool"


    Code:
    Private Sub UserForm_Initialize()
    
    Range("A1").Select
      
    On Error Resume Next
    Dim lng As Long
    Dim col As New Collection
     
    'haal unieke data uit huidig bestand 
    
     lng = 2    'vanaf regel inlezen in collectie 
     Do Until Cells(lng, 5).Value = "" '5 is het kolom nummer
     col.Add Cells(lng, 5), Cells(lng, 5).Text
     lng = lng + 1
     Loop
    
    'wegschrijven data in Listbox1
    
     lng = 0 'begin bij eerst regel in listbox
     For lng = 1 To col.Count
     Me.ListBox1.AddItem col(lng)
     
     Next
    
    End Sub
    Ik ben al wel redelijk bekend met VBA maar dit gaat toch nog ff te ver wat betreft mijn kennis.

    Hoop dat iemand mij kan helpen.

    Groet,

    Jeffrey
    Attached Files Attached Files

  2. #2
    Giga Honourable Senior Member
    Verenigingslid

    Geregistreerd
    12 juni 2008
    Gebruik nooit additem (en zeker niet als je een dictionary gebruikt):
    Geef altijd de verwijzing naar het werkblad aan

    Code:
    Private Sub UserForm_Initialize()
       for each it in sheet1.columns(5).specialcells(2)
         if instr(c00 & "_","_" & it & "_")=0 then c00=c00 & "_"& it.value
       next
       Listbox1.list=split(mid(c00,2),"_")
    End Sub
    Zie: http://www.snb-vba.eu/VBA_Fill_combobox_listbox.html
    en

    http://www.snb-vba.eu/VBA_Dictionary.html
    Laatst aangepast door snb : 17 juli 2017 om 15:44
    VBA voor smarties

    VBA is een taal die je moet leren met een grammatica- en een woordenboek.
    Plaats svp geen bestanden op andere sites; nadat het bestand daar verwijderd is wordt een forumdraad onbegrijpelijk voor anderen.

  3. #3
    Mega Honourable Senior Member
    Geregistreerd
    2 maart 2013
    Even los van de nuttige tips in #2. Wat doen al die On error's in de code?

    Als antwoord op de vraag en dus een aanvulling op #2 over het gebruik van een dictionary (is ook een collection)

    Code:
    Private Sub UserForm_Initialize()
      ar = Sheets("Blad1").Cells(1).CurrentRegion
      With CreateObject("scripting.dictionary")
        For j = 2 To UBound(ar)
          .Item(ar(j, 5)) = .Item(ar(j, 5)) + 1
        Next j
        ListBox1.List = Application.Transpose(Array(.keys, .items))
      End With
    End Sub
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  4. #4
    Beste snb,

    Bedankt voor jou reactie.

    Ik had al wel jouw site gevonden met de uitleg mbt ListBox/ComboBox. Omdat ik nog nooit met ListBox heb gewerkt is het nog even behelpen. De code die ik gebruik heb ik van een Webcrawler programma geleased.

    ik krijg een syntaxfout op dit gedeelte:

    Code:
    next & "_"
    mis ik iets?
    Laatst aangepast door puppie : 17 juli 2017 om 18:10 Reden: onnodige quote

  5. #5
    Beste VenA,

    Bedankt voor jouw hulp. Deze code laat inderdaad zien wat ik wil.

    Eerlijk gezegd heb ik geen idee waarom deze "on error" er in staan. Deze code heb ik overgenomen en aangepast naar mijn wens om de macro makkelijker te kunnen vinden op pc magazijn man.

    Ik krijg het alleen nog niet voor elkaar om een kolom 2 van hoog naar laag te sorteren. Ik dacht dat dit meteen in de dictionaty moet of zit ik verkeerd?
    Laatst aangepast door puppie : 17 juli 2017 om 18:09 Reden: onnodige quote

  6. #6
    Giga Honourable Senior Member
    Verenigingslid

    Geregistreerd
    12 juni 2008
    na next hoort ook niets meer te staan (zie #2 aangepast)
    VBA voor smarties

    VBA is een taal die je moet leren met een grammatica- en een woordenboek.
    Plaats svp geen bestanden op andere sites; nadat het bestand daar verwijderd is wordt een forumdraad onbegrijpelijk voor anderen.

  7. #7
    Beste snb,

    Ga ermee aan de gang. bedankt voor je snelle feedback.

  8. #8
    Mega Honourable Senior Member
    Geregistreerd
    2 maart 2013
    Het quoten is niet nodig.

    Voor zover ik weet kan je een dictionary niet sorteren. Het meest eenvoudig is om de gegevens weg te schrijven ergens in een blad vervolgens de gegevens sorteren en dan inladen in de Listbox.

    Code:
    Private Sub UserForm_Initialize()
      ar = Sheets("Blad1").Cells(1).CurrentRegion
      Set d = CreateObject("scripting.dictionary")
        For j = 2 To UBound(ar)
          d.Item(ar(j, 5)) = d.Item(ar(j, 5)) + 1
        Next j
        With Sheets("Blad2").Cells(1)
          .Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
          .CurrentRegion.Sort .Cells(1, 2), , .Cells(1)
          ListBox1.List = .CurrentRegion.Value
        End With
    End Sub
    Laatst aangepast door VenA : 17 juli 2017 om 19:53 Reden: tip HSV
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  9. #9
    Giga Honourable Senior Member HSV's avatar
    Geregistreerd
    18 juli 2008
    @VenA,
    Code:
    d.Count
    ____________
    mvg,
    Harry

    Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
    (Grunnegs-Gronings)

  10. #10
    Giga Honourable Senior Member
    Verenigingslid

    Geregistreerd
    12 juni 2008
    Uniek en gesorteerd

    Code:
    Private Sub UserForm_Initialize()
      With CreateObject("System.Collections.ArrayList")
         for each it in sheet1.columns(5).specialcells(2)
           If Not .contains(it.value) Then .Add it.value
         Next
         .Sort
         Listbox1.list=.toarray  
      End With
    End Sub
    Zie ook: http://www.snb-vba.eu/VBA_Arraylist.html#L_0
    Laatst aangepast door snb : 17 juli 2017 om 19:53
    VBA voor smarties

    VBA is een taal die je moet leren met een grammatica- en een woordenboek.
    Plaats svp geen bestanden op andere sites; nadat het bestand daar verwijderd is wordt een forumdraad onbegrijpelijk voor anderen.

  11. #11
    Giga Honourable Senior Member HSV's avatar
    Geregistreerd
    18 juli 2008
    Zover was ik ook @snb,

    ... maar ik krijg de telling daar niet achter.

    Overigens...
    Code:
    If Not .contains(it.value)
    Ik ga er derhalve maar vanuit dat er geen nummering achter de debiteur-naam staat.

    Code:
    Private Sub UserForm_Initialize()
    Dim sn, arr, i As Long, ii As Long, j As Long, tmp
    With Sheets(1)
    sn = .Cells(1).CurrentRegion
    Set d = CreateObject("scripting.dictionary")
        For j = 2 To UBound(sn)
          d.Item(sn(j, 5)) = d.Item(sn(j, 5)) + 1
        Next j
    ReDim arr(d.Count - 1, 1)
     For i = 0 To d.Count - 1
       arr(i, 0) = d.keys()(i)
       arr(i, 1) = d.Item(d.keys()(i))
     Next i
     For ii = 0 To d.Count - 1
        For j = ii + 1 To d.Count - 1
           If arr(ii, 1) < arr(j, 1) Then
                tmp = arr(j, 0) & "|" & arr(j, 1) & "|"
                arr(j, 0) = arr(ii, 0)
                arr(j, 1) = arr(ii, 1)
                arr(ii, 0) = Split(tmp, "|")(0)
                arr(ii, 1) = Split(tmp, "|")(1)
            End If
        Next j
      Next ii
    End With
    ListBox1.List = arr
    End Sub
    ____________
    mvg,
    Harry

    Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
    (Grunnegs-Gronings)

  12. #12
    Giga Honourable Senior Member
    Verenigingslid

    Geregistreerd
    12 juni 2008
    @HSV
    gebruik een sortedlist.

    Maar liever gewoon een simpele draaitabel.
    VBA voor smarties

    VBA is een taal die je moet leren met een grammatica- en een woordenboek.
    Plaats svp geen bestanden op andere sites; nadat het bestand daar verwijderd is wordt een forumdraad onbegrijpelijk voor anderen.

  13. #13
    bedankt allen voor jullie input. Voor wat betreft ListBox/ComboBox heb ik nog ff wat te leren.

    @VenA. heb jouw code iets aangepast en hij sorteert nu hoog/laag op de kolom aantal regels

    Code:
    .CurrentRegion.Sort .Cells(1, 2), , .Cells(2), Order1:=xlDescending
    Ik zal ook even verder in de andere code duiken om te kijken of het dan idd zonder Blad2 kan.

    Nogmaals allemaal bedankt.

  14. #14
    Mega Honourable Senior Member
    Geregistreerd
    2 maart 2013
    De sortering is prima alleen staat Klant10 in rangorde wat hoger dan Klant7 en daar gaat geen enkele sorteervolgorde iets aan wijzigen. Klant007 en Klant010 zal een beter sorteerveld leveren.
    Laatst aangepast door VenA : 18 juli 2017 om 12:44
    Je kan een paard naar het water leiden, maar je kan het niet dwingen te drinken.

  15. #15
    Giga Honourable Senior Member HSV's avatar
    Geregistreerd
    18 juli 2008
    Toch een manier gevonden om een telling in de sorted-arraylist te maken.
    Code:
    Private Sub UserForm_Initialize()
    Dim it As Range
      Set d = CreateObject("System.Collections.ArrayList")
         For Each it In Blad1.Columns(5).SpecialCells(2).Offset(1)
          If d.capacity = 0 Then d.Add it.Value & "|0"
             If InStr(Join(d.toarray), it.Value & "|") = 0 Then
                 d.Add it.Value & "|1"
             Else
                For i = 0 To d.Count - 1
                  If d(i) Like it.Value & "|*" Then
                    d(i) = Split(d(i), "|")(0) & "|" & Split(d(i), "|")(1) + 1
                  End If
                Next i
            End If
         Next it
         d.Sort
        ' MsgBox Join(d.toarray, vbLf)
         ListBox1.List = Split(Join(d.toarray, vbLf), vbLf)
    End Sub
    ____________
    mvg,
    Harry

    Lag nooit om de keuzes van dien vraauw, bist ter zulf aine van....
    (Grunnegs-Gronings)

Berichtenregels

  • U mag geen nieuwe vragen starten.
  • U mag niet reageren op berichten.
  • U mag geen bijlagen versturen.
  • U mag uw berichten niet bewerken.
  •  
Helpmij.nl
Helpmij.nl

Helpmij.nl en business

Partners
Sponsoren
Aanbiedingen