=PLADS() med bogstaver?

Kan du ikke sortere dine felter?
Hvis du derefter vil have dem nummereret 1, 2, 3 osv. kan du bruge formlen =RÆKKE(A1) til at give dem et nummer, som bevares selv om du efterfølgende sorterer.

Nej, jeg kan ikke blot sorter mine felter, da indholdet ændrer sig gang på gang, og det skal desuden være automatisk - så, manuel sortering virker ikke :-(

Man kan godt lave en semi-automatisk løsning, hvor man kører en sorteringsmakro hver gang man går ind på et ark eller ændrer en bestemt celle.

Ja, det ved jeg, men til dette bestemte formål her kan det ikke bruges (ellers havde jeg lavet det, da dette ikke er så svært ;-)

Så må vi få en VBA-haj til at kode en funktion :-)
Hvis man erstatter hvert bogstav med et tal må man kunne bruge =PLADS-funktionen.

VBA-hajen i huset - hvad skal jeg kode 8-)

Hej Flemming :-)
En funktion som oversætter a til 1, b til 2, c til 3 osv. og så oversætter en hel tekststreng til et tal, som så indsættes i en PLADS-funktion.
Lidt indviklet, men nok ikke umulig for dig :-)

ok - den er nem

hvordan skal så tolkes.... når jeg returnerer 1231324 abcacbd eller LCACX ?
skal der f.eks. kommaer imellem tallene eller ?

Når man skriver afc skal den returnere 163 - uden komma.

Tallet kan man derefter beregne på. Det er ikke så nemt med en tekststreng.

Public Function StringToNumber(ByVal sText As Range) As Double
    Dim sRetVal As String
    Dim lChr As Long
    Application.Volatile
   
    For lChr = 1 To Len(sText)
        sRetVal = sRetVal & CStr(AlfaNumber(Mid(sText, lChr, 1)))
    Next lChr
   
    StringToNumber = CDbl(sRetVal)
End Function

Private Function AlfaNumber(ByVal sChar As String) As Long
    Dim lRetVal As Long
    Select Case LCase(sChar)
        Case "a": lRetVal = 1
        Case "b": lRetVal = 2
        Case "c": lRetVal = 3
        Case "d": lRetVal = 4
        Case "e": lRetVal = 5
        Case "f": lRetVal = 6
        Case "g": lRetVal = 7
        Case "h": lRetVal = 8
        Case "i": lRetVal = 9
        Case "j": lRetVal = 10
        Case "k": lRetVal = 11
        Case "l": lRetVal = 12
        Case "m": lRetVal = 13
        Case "n": lRetVal = 14
        Case "o": lRetVal = 15
        Case "p": lRetVal = 16
        Case "q": lRetVal = 17
        Case "r": lRetVal = 18
        Case "s": lRetVal = 19
        Case "t": lRetVal = 20
        Case "u": lRetVal = 21
        Case "v": lRetVal = 22
        Case "w": lRetVal = 23
        Case "x": lRetVal = 24
        Case "y": lRetVal = 25
        Case "z": lRetVal = 26
        Case "æ": lRetVal = 27
        Case "ø": lRetVal = 28
        Case "å": lRetVal = 29
    End Select
    AlfaNumber = lRetVal
End Function

Ups, overså lige, at alfabetet indeholder mere end 9 bogstaver!
Men ellers virker den perfekt ...hmmm, hva' gør vi så ....

jo deet...

Kan man ikke korrigere, så 1 bliver til 01?

jooo... men så har du pludselig en tekst... idet intet tal starter med NUL

Du har ret, men så sæt et 1-tal foran alle "strenge". Kan det så blive et tal?

Ja, det var ikke helt den tilgang til problemet, jeg efterspurgte, men i samarbejde med funktionen =PLADS(), så virker det :-)

Hmm, er det ikke 15 cifre, som er det maksimale Excel kan arbejde med?

Pistol ..>Der findes ikke en direkte funktion til formålet, så det kræver lidt kreativitet :-)

Det virker ikke alligevel :-(
Plads nægter at acceptere forskellen, hvis jeg skriver..

Frederikshavn og Frederikssund

Det har noget at gøre med, at over et vist antal cifre i nummeret, så bliver nummeret ens!  :-(

Ja, Excel kan vist kun håndtere 15 cifre ...

D.v.s. at den kan behande 7 bogstaver af gangen (7*2=14 < 15).
Hvis man så på en eller anden måde kunne dele den i 2, så ville man have 15 bogstaver til rådighed, hvilket sandsynligvis ville være tilstrækkeligt - ihvertfald til eksemplet.

Jeg laver lige noget jeg kan tjene penge på istedet, så kan du tænke videre *ss*

En array funktion, husk at afslutte med CTRL+SHIFT+ENTER
Marker i en tom kolonne lige så langt som data, skriv =TekstPlads(A1:A3), hvor A1:A3 er jeres område med tekst.


Public Function TekstPlads(Område As Range) As Variant
Dim Res(), I As Long, Y As Long, X As Long
    Dim AnyChanges As Boolean
    Dim BubbleSort As Long
    Dim SwapFH As Variant
    X = 0
    Data1 = Range("A1:A3")
    Data2 = Range("A1:A3")

    Do
        AnyChanges = False
        For BubbleSort = LBound(Data1) To UBound(Data1) - 1
            If (Data1(BubbleSort, 1) > Data1(BubbleSort + 1, 1) And SortAscending) _
              Or (Data1(BubbleSort, 1) < Data1(BubbleSort + 1, 1) And Not SortAscending) Then
                ' These two need to be swapped
                SwapFH = Data1(BubbleSort, 1)
                Data1(BubbleSort, 1) = Data1(BubbleSort + 1, 1)
                Data1(BubbleSort + 1, 1) = SwapFH
                AnyChanges = True
            End If
        Next BubbleSort
    Loop Until Not AnyChanges
    For I = 1 To UBound(Data1)
        For Y = 1 To UBound(Data2)
            If Data1(I, 1) = Data2(Y, 1) Then
                ReDim Preserve Res(X)
                Res(X) = Y
                X = X + 1
                Exit For
            End If
        Next
    Next
    TekstPlads = Application.WorksheetFunction.Transpose(Res)
End Function

den var vist ikke testet ordentlig, arbejder videre ;-(

enjoy

prøver igen, test venligst

Public Function TekstPlads(Område As Range, Stigende_J_N) As Variant
    Dim Res(), I As Long, Y As Long
    Dim AnyChanges As Boolean
    Dim BubbleSort As Long
    Dim SwapFH As Variant
    Data1 = Range(Område.Address)
    Data2 = Range(Område.Address)
    ReDim Res(UBound(Data1) - 1)

    Select Case UCase(Stigende_J_N)
    Case "J"
        Do
            AnyChanges = False
            For BubbleSort = LBound(Data1) To UBound(Data1) - 1
                If Data1(BubbleSort, 1) > Data1(BubbleSort + 1, 1) Then
                    SwapFH = Data1(BubbleSort, 1)
                    Data1(BubbleSort, 1) = Data1(BubbleSort + 1, 1)
                    Data1(BubbleSort + 1, 1) = SwapFH
                    AnyChanges = True
                End If
            Next BubbleSort
        Loop Until Not AnyChanges
    Case "N"
        Do
            AnyChanges = False
            For BubbleSort = LBound(Data1) To UBound(Data1) - 1
                If Data1(BubbleSort, 1) < Data1(BubbleSort + 1, 1) Then
                    SwapFH = Data1(BubbleSort + 1, 1)
                    Data1(BubbleSort + 1, 1) = Data1(BubbleSort, 1)
                    Data1(BubbleSort, 1) = SwapFH
                    AnyChanges = True
                End If
            Next BubbleSort
        Loop Until Not AnyChanges
    End Select
    For I = 1 To UBound(Data1)
        For Y = 1 To UBound(Data2)
            If Data1(I, 1) = Data2(Y, 1) Then
                Res(Y - 1) = I
                Exit For
            End If
        Next
    Next
    TekstPlads = Application.WorksheetFunction.Transpose(Res)
End Function

har rette lidt i den, hvis der er flere ens får de fortløbende pladser

Public Function TekstPlads(Område As Range, Stigende_J_N) As Variant
    Dim Res(), I As Long, Y As Long
    Dim AnyChanges As Boolean
    Dim BubbleSort As Long
    Dim SwapFH As Variant
    Data1 = Range(Område.Address)
    Data2 = Range(Område.Address)
    ReDim Res(UBound(Data1) - 1)

    Select Case UCase(Stigende_J_N)
    Case "J"
        Do
            AnyChanges = False
            For BubbleSort = LBound(Data1) To UBound(Data1) - 1
                If Data1(BubbleSort, 1) > Data1(BubbleSort + 1, 1) Then
                    SwapFH = Data1(BubbleSort, 1)
                    Data1(BubbleSort, 1) = Data1(BubbleSort + 1, 1)
                    Data1(BubbleSort + 1, 1) = SwapFH
                    AnyChanges = True
                End If
            Next BubbleSort
        Loop Until Not AnyChanges
    Case "N"
        Do
            AnyChanges = False
            For BubbleSort = LBound(Data1) To UBound(Data1) - 1
                If Data1(BubbleSort, 1) < Data1(BubbleSort + 1, 1) Then
                    SwapFH = Data1(BubbleSort + 1, 1)
                    Data1(BubbleSort + 1, 1) = Data1(BubbleSort, 1)
                    Data1(BubbleSort, 1) = SwapFH
                    AnyChanges = True
                End If
            Next BubbleSort
        Loop Until Not AnyChanges
    End Select
    For I = 1 To UBound(Data1)
        For Y = 1 To UBound(Data2)
            If Data1(I, 1) = Data2(Y, 1) Then
            Data1(I, 1) = Empty
            Data2(Y, 1) = -1
                Res(Y - 1) = I
            End If
        Next
    Next
    TekstPlads = Application.WorksheetFunction.Transpose(Res)
End Function

Kabbak >  Tak for hjælpen :-)

Jeg har lige været inde og kigge her til morgen...
Jeg får dog ikke tid til at teste før i aften, men skal nok vende tilbage...

Ja, det virker umiddelbart, men giver mig et nyt problem :-(

Det var meningen at en makro skulle skrive formelen i øverste celle, og derefter trække denne celle og sideliggende celle nedad et vist antal rækker.

Dette giver denne løsning ikke mulighed for :-(
På denne måde kan jeg jo lige så godt markerer et område og sortere dette - som har været diskuteret i denne tråd tidligere...

Nåh, jeg kan vel blot lære at udtrykke mig ordenligt ;-)

Jeg prøver lige at lege lidt videre med ideen med at omdanne teksten til et tal - evt. over flere omgange...

Her er en du kan trække, det er IKKE en array funktion.

Public Function TekstPlads(Område As Range, Reference, Stigende_J_N) As Variant
    Dim Res(), I As Long, Y As Long
    Dim AnyChanges As Boolean
    Dim BubbleSort As Long
    Dim SwapFH As Variant
    Data1 = Range(Område.Address)
    Data2 = Range(Område.Address)
    ReDim Res(UBound(Data1) - 1)

    Select Case UCase(Stigende_J_N)
    Case "J"
        Do
            AnyChanges = False
            For BubbleSort = LBound(Data1) To UBound(Data1) - 1
                If Data1(BubbleSort, 1) > Data1(BubbleSort + 1, 1) Then
                    SwapFH = Data1(BubbleSort, 1)
                    Data1(BubbleSort, 1) = Data1(BubbleSort + 1, 1)
                    Data1(BubbleSort + 1, 1) = SwapFH
                    AnyChanges = True
                End If
            Next BubbleSort
        Loop Until Not AnyChanges
    Case "N"
        Do
            AnyChanges = False
            For BubbleSort = LBound(Data1) To UBound(Data1) - 1
                If Data1(BubbleSort, 1) < Data1(BubbleSort + 1, 1) Then
                    SwapFH = Data1(BubbleSort + 1, 1)
                    Data1(BubbleSort + 1, 1) = Data1(BubbleSort, 1)
                    Data1(BubbleSort, 1) = SwapFH
                    AnyChanges = True
                End If
            Next BubbleSort
        Loop Until Not AnyChanges
    End Select
    For I = 1 To UBound(Data1)
        If Reference = Data1(I, 1) Then
        TekstPlads = I
        Exit Function
        End If
    Next
End Function

Genial funktion!
Kan det passe, at store bogstaver (versaler) kommer før små bogstaver?
Og at der er lidt problemer med "æøå"?

janvogt >
Jeg hat ikke testet, om der er problemer med store/små bogstever og æøå.

resultatet er en almindelig sortering, enten stigende eller faldende,

Tak for hjælpen Kabbak :-)
Som Jan skriver: Genial funktion :-)
Jeg har fået det til at virker, som jeg ønsker :-)

Smid et svar og du får nogle point :-)

Pistolprinsen

Tak for det, rettede du i koden, hvis ja, vil jeg da gerne se resultatet.

og et svar ;-))