• 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.

alfabetiseren binnen één cel

Status
Niet open voor verdere reacties.
Mmmmmmmmmmmm, niet bij mij weten.

Post eens een voorbeeld (zonder prive gegevens) krijgen we een beter zicht op wat je precies bedoelt?
 
voorbeeld

Data zoals in cel C4 zou gesorteerd moeten worden. (in dit geval op alfabetische volgorde)
 

Bijlagen

  • test.jpg
    test.jpg
    32,9 KB · Weergaven: 65
Vooruit, heb code voor je geschreven.

Code: 
Sub Macro2()
    Dim rngBegin As Range, rngCells As Range, l As Long
    Application.ScreenUpdating = False
    Set rngBegin = ActiveCell
    With rngBegin
        .TextToColumns Destination:=rngBegin, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=True, Other:=True, OtherChar:=Chr(10), FieldInfo:=Array(Array(1, 2), Array(2, 1))
        Set rngCells = Range(.Cells(1), .End(xlToRight))
        rngCells.Sort Key1:=rngCells.Range("A1"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
            Orientation:=xlLeftToRight
        For l = 2 To rngCells.Count - 1
            rngBegin = rngBegin & Chr(10) & rngCells(l)
        Next
    End With
    rngBegin.Offset(, 1).Resize(, rngCells.Count - 1).ClearContents
    Application.ScreenUpdating = True
End Sub

Enige voorwaarde is dat er rechts van de sorteren cel geen data staan.

Wigi
 
Laatst bewerkt:
Neerlands hoop in bange dagen.:thumb:

pffffffff, ga dit eens even fijn uitpluizen Wigi.
Kwam er zelf totaal niet uit.
 
Je website ziet er netjes uit, overzichtelijker dan de vorige :).
Frisse kleuren en goed te navigeren.

Puntje:
Sommige Excel codes vallen buiten hun kader, en zitten ergens onderin je pagina.
Maar daar zal al wel aan gewerkt worden.

Bedankt voor de Excel pagina:D
 
Verbeterde code:

Code: 
Sub SorterenInEenCel()
    Dim l As Long, arrParts As Variant, str1 As String, str2 As String, lLoop As Long, lLoop2 As Long, concat As String
    arrParts = Split(ActiveCell, Chr(10))
    For lLoop = 0 To UBound(arrParts)
       For lLoop2 = lLoop To UBound(arrParts)
            If UCase(arrParts(lLoop2)) < UCase(arrParts(lLoop)) Then
                str1 = arrParts(lLoop)
                str2 = arrParts(lLoop2)
                arrParts(lLoop) = str2
                arrParts(lLoop2) = str1
            End If
        Next lLoop2
    Next lLoop
    
    For lLoop = 1 To UBound(arrParts)
       concat = concat & Chr(10) & arrParts(lLoop)
    Next lLoop
    ActiveCell = arrParts(0) & concat
End Sub

Nu hoef je geen lege cellen meer te hebben. :eek: :D

Wigi
 
Nog even bezig geweest met de code. En ik heb ze nog een stuk verbeterd.

Code: 
Sub SorterenInEenCel()
    Dim l As Long, arrSubParts As Variant, rngSorteren As Range, rng As Range, strToSort As String
    Dim str1 As String, str2 As String, lLoop As Long, lLoop2 As Long
    Application.ScreenUpdating = False
    
    Set rngSorteren = Application.InputBox("Duid de te sorteren cellen aan.", "Cellen aanduiden", Selection.Address, Type:=8)
    If WorksheetFunction.Min(rngSorteren.Rows.Count, rngSorteren.Columns.Count) > 1 Or rngSorteren Is Nothing Then Exit Sub

    For Each rng In rngSorteren
        strToSort = rng.Value
        If strToSort <> "" Then
            
            Do While InStr(strToSort, Chr(10) & Chr(10)) > 0
                strToSort = Replace(strToSort, Chr(10) & Chr(10), Chr(10))
            Loop
            Do While Left(strToSort, 1) = Chr(10)
                strToSort = Right(strToSort, Len(strToSort) - 1)
            Loop
            Do While Right(strToSort, 1) = Chr(10)
                strToSort = Left(strToSort, Len(strToSort) - 1)
            Loop
            
            arrSubParts = Split(strToSort, Chr(10))
            
            For lLoop = 0 To UBound(arrSubParts)
               For lLoop2 = lLoop To UBound(arrSubParts)
                    If UCase(arrSubParts(lLoop2)) < UCase(arrSubParts(lLoop)) Then
                        str1 = arrSubParts(lLoop)
                        str2 = arrSubParts(lLoop2)
                        arrSubParts(lLoop) = str2
                        arrSubParts(lLoop2) = str1
                    End If
                Next lLoop2
            Next lLoop
            
            rng.Value = Join(arrSubParts, Chr(10))
        End If
    Next rng
    Application.ScreenUpdating = True
End Sub

Toch wel enkele interessante stukken code zou ik zo zeggen. Vooral Split en Join zijn heel handig. Chr(10) staat voor de Enter tussen opeenvolgende lijnen.

De code haalt eventuele lege lijen er ook uit.

Enige minpunt is dat het tekst sorteert, geen getallen. Getallen worden wel "alfabetisch gesorteerd": 123 dan 45 dan 678 (1 komt voor de 4, die voor de 6 komt).

Wigi
 
This because the internal binary representations of the characters in Windows are seen in a table something like:
A < B < E < Z < a < b < e < z < À < Ê < Ø < à < ê < ø
Klik om te vergroten...
 
Ik weet idd hoe het komt, alleen heb ik er nog geen code voor kunnen schrijven die ook dit kan opvangen.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan