• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Sorteren 1,1A,1B

Status
Niet open voor verdere reacties.
B

Bas1980

Gebruiker
Lid geworden
15 dec 2013
Berichten
64
Hallo allemaal,

Ik ben op zoek naar de code om op nummer te kunnen sorteren. Deze nummers lopen van 1, 1A tot Z en 9999A tot Z. Een customlist, macro opnemen en dan de code uit de macro halen werkt niet omdat ik geen duizenden nummers in deze lijst kan zetten.

Heb ook al diverse code geprobeerd maar het wil maar niet lukken. Alles omzetten naar text en dan sorteren werkt ook niet. 100 komt dan ineens na 10 etc.

Wie o wie heeft er een oplossing?

Bekijk bijlage Testmetbox.xlsm

Gaat om de code achter het invoeren van een sleutel in de tab Database sleutels. Wanneer je in Visual Basic het formulier FRMsleuteltoevoegen opent en vervolgens naar de code achter dit formulier gaat staat er ergens een kopje sorteren en op alfabetische volgorde zetten. Hier moet de betreffende code dus komen te staan.

Groetjes Bas
 
Laatst bewerkt:
Zie #4 ;)
 
Voeg een extra kolom toe met de sorteersleutel:
=RECHTS("00000"&A2;5)
 
Die had ik ook al eens gezien. invoeren door ctrl+shift+enter? Kan ik die kolom ook weer verbergen?

Kreeg hem niet werkend vandaar. Hoe en waar moet ik deze invoeren en wat moet ik doen?
 
Zie voorbeeld

(ctrl+shift+enter gebruik je voor matrixformules!)
 

Bijlagen

  • Testmetbox ma.xlsm
    846,1 KB · Weergaven: 40
=als(rechts(a2)>="a";rechts("00000"&a2;5);rechts("0000"&a2&" ";5))
 
Macrootje:
Code: 
Sub tsh()
    Dim Br, Sh
    Dim i As Long
    Dim lGetal As Double, sTekst As String
    
    Set Sh = Sheets("Database sleutels")
    Br = Sh.Cells(1).CurrentRegion
    With CreateObject("System.Collections.Sortedlist")
        For i = 2 To UBound(Br)
            lGetal = Evaluate("lookup(9e99,mid(""" & Br(i, 1) & """,1,row(1:100))*1)")
            sTekst = Replace(Br(i, 1), CStr(lGetal), "")
            For j = 1 To Len(sTekst)
                lGetal = lGetal + (Asc(Mid(sTekst, j, 1)) - 50) * 100 ^ (-j)
            Next
            .Add lGetal, i
        Next
        For i = 0 To .Count - 1
            Sh.Cells(i + 2, 1).Resize(, 6) = Application.Index(Br, .GetByIndex(i), [column(A:F)])
        Next
    End With
End Sub
 
Timshel zei:
Macrootje:
Code: 
Sub tsh()
    Dim Br, Sh
    Dim i As Long
    Dim lGetal As Double, sTekst As String
    
    Set Sh = Sheets("Database sleutels")
    Br = Sh.Cells(1).CurrentRegion
    With CreateObject("System.Collections.Sortedlist")
        For i = 2 To UBound(Br)
            lGetal = Evaluate("lookup(9e99,mid(""" & Br(i, 1) & """,1,row(1:100))*1)")
            sTekst = Replace(Br(i, 1), CStr(lGetal), "")
            For j = 1 To Len(sTekst)
                lGetal = lGetal + (Asc(Mid(sTekst, j, 1)) - 50) * 100 ^ (-j)
            Next
            .Add lGetal, i
        Next
        For i = 0 To .Count - 1
            Sh.Cells(i + 2, 1).Resize(, 6) = Application.Index(Br, .GetByIndex(i), [column(A:F)])
        Next
    End With
End Sub
Klik om te vergroten...

Als ik deze code gebruik werkt hij zoals die moet werken. Echter krijg ik nu, bij het uitlenen van 2 dezelfde sleutels (bijvoorbeeld sleutelnummer 2) dat excel een foutmelding geeft.
Het betreft deze foutmelding:

Run-time error '-2147024809 (80070057)':
Item is al toegevoegd. Sleutel in woordenboek: 2, Sleutel die wordt toegevoegd: 2

Hij lijkt vast te lopen op: .Add lGetal, i

Groetjes Bas
 
Code: 
Sub tsh()
    Dim Br, Sh
    Dim i As Long
    
    Set Sh = Sheets("Database sleutels")
    Br = Sh.Cells(1).CurrentRegion
    With CreateObject("System.Collections.Sortedlist")
        For i = 2 To UBound(Br)
            .Add Evaluate("iferror(""" & Br(i, 1) & """*1,left(""" & Br(i, 1) & """,len(""" & _
                Br(i, 1) & """)-1)*1+(code(right(""" & Br(i, 1) & """,1))-50)/100)") + i / 100000, i
        Next
        For i = 0 To .Count - 1
            Sh.Cells(i + 2, 1).Resize(, 6) = Application.Index(Br, .GetByIndex(i), [column(A:F)])
        Next
    End With
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan