Listbox in combinatie met AANTAL in kolom 2

Status
Niet open voor verdere reacties.

DarkValley

Gebruiker
Lid geworden
11 jan 2007
Berichten
59
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
 

Bijlagen

  • HM_PicklistMakenTest.xlsm
    38,2 KB · Weergaven: 33
Laatst bewerkt:
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
 
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 bewerkt door een moderator:
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 bewerkt door een moderator:
na next hoort ook niets meer te staan (zie #2 aangepast)
 
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 bewerkt:
@VenA,
Code:
[COLOR=#ff0000]d.[/COLOR][COLOR=#ff0000][/COLOR][COLOR=#ff0000][/COLOR][COLOR=#000000]Count[/COLOR]
 
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 bewerkt:
Zover was ik ook @snb,

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

Overigens...
Code:
If Not .contains(it[COLOR=#ff0000].value[/COLOR])

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
 
@HSV
gebruik een sortedlist. ;)

Maar liever gewoon een simpele draaitabel.
 
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.
 
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 bewerkt:
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
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan