Helpmij.nl
Helpmij.nl
Helpmij.nl

Quote

Weergeven resultaten 1 tot 12 van 12

Onderwerp: alfabetiseren binnen één cel

  1. #1
    Vraag is opgelost

    alfabetiseren binnen één cel

    Is het mogelijk om binnen 1 cel data te alfabetiseren?

  2. #2
    Mega Senior
    Verenigingslid

    Geregistreerd
    24 mei 2006
    Mmmmmmmmmmmm, niet bij mij weten.

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

  3. #3

    voorbeeld

    Data zoals in cel C4 zou gesorteerd moeten worden. (in dit geval op alfabetische volgorde)
    Bijgevoegde kleine afbeeldingen Bijgevoegde kleine afbeeldingen Klik op afbeelding voor grotere versie

Naam:  test.jpg‎
Bekeken: 54
Grootte:  32,9 KB  

  4. #4
    Giga Honourable Senior Member
    Geregistreerd
    5 april 2006
    Locatie
    Mechelen
    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 aangepast door Wigi : 23 februari 2007 om 12:46 Reden: typo

  5. #5
    Mega Senior
    Verenigingslid

    Geregistreerd
    24 mei 2006
    Neerlands hoop in bange dagen.

    pffffffff, ga dit eens even fijn uitpluizen Wigi.
    Kwam er zelf totaal niet uit.

  6. #6
    Giga Honourable Senior Member
    Geregistreerd
    5 april 2006
    Locatie
    Mechelen
    Quote Origineel gepost door Demeter Bekijk Bericht
    Neerlands hoop in bange dagen.
    Dit is inderdaad eentje voor op mijn site

  7. #7
    Mega Senior
    Verenigingslid

    Geregistreerd
    24 mei 2006
    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

  8. #8
    Giga Honourable Senior Member
    Geregistreerd
    5 april 2006
    Locatie
    Mechelen
    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.

    Wigi

  9. #9
    THNX

  10. #10
    Giga Honourable Senior Member
    Geregistreerd
    5 april 2006
    Locatie
    Mechelen
    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

  11. #11
    Mega Senior
    Verenigingslid

    Geregistreerd
    24 mei 2006
    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 < À < Ê < Ø < à < ê < ø

  12. #12
    Giga Honourable Senior Member
    Geregistreerd
    5 april 2006
    Locatie
    Mechelen
    Ik weet idd hoe het komt, alleen heb ik er nog geen code voor kunnen schrijven die ook dit kan opvangen.

  13. Dit topic is automatisch gesloten omdat er sinds vier maanden niet meer op gereageerd is.

    Indien gewenst kan de topicstarter een verzoek tot heropening indienen.

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

Regels
Help

Helpmij.nl en business

Partners
Sponsoren