Bepaalde letters omzetten naar HOOFDLETTERS

[Tsarevitsj]

Hallo,

Hoe kan ik in een formule bepalen dat in een Range, b.v. A1:B10 alleen bepaalde kleine letters worden omgezet naar hoofdletters, dus b.v. de a, b,c en d.
Alle andere letters moeten ongemoeid blijven.

Ik heb zitten knoeien met =HOOFDLETTERS maar kan daar geen Range aan plakken?

Bvd Tsarevitsj

Edit: het gaat om Excel 2002

 

[Ginger]

Tsarevitsj, Dat kan je alleen oplossen met VBA en een Change-event. Daar kan je uitvragen in welke range je zit en via een Select Case bekijken met welke letter je te maken hebt.
Zet je trouwens alléén die ene letter in die cel of krijg je echt een woord als AAp of ABsoluut of CeDerhout???

Groet, Leo

 

[Tsarevitsj]

Het gaat om dit soort codes (letters);

l
d9
dp7
d#
n

enz.

Mocht het alleen met VBA kunnen, moet ik deze vraag dan in dat forumgedeelte opnieuw stellen?

Alvast bedankt voor je reactie hoor...

 

[Ginger]

...en nu ik er iets langer over denk... Het kan wel met de functie Substitute (SUBSTITUEREN)... Maarrrr... dan moet je niet te veel letters willen omzetten, anders wordt 't redelijk onoverzichtelijk! Voor je voorgestelde letters wordt het (in cel A1 je woord; in cel B1 deze formule)

=SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A1;"a";"A");"b";"B");"c";"C");"d";"D")

NL   =SUBSTITUEREN(SUBSTITUEREN(SUBSTITUEREN(SUBSTITUEREN(A1;"a";"A");"b";"B");"c";"C");"d";"D")

Groet, Leo

 

[Tsarevitsj]

Leo, zoals je zelf al aangaf, het zou 1680 cellen betreffen en ± 30 letters/combinaties, dat is dan niet meer te doen op deze manier.

Ik ga proberen het in VBA op te lossen, lukt me dat niet, dan meld ik me hier weer.

Anyway, heel erg bedankt voor de reactie en het meedenken hoor :thumb:

 

[Ginger]

Tsarevitsj, Een UDF heb ik zo voor je geschreven. Maar je moet ff wat meer info geven. In je initiele vraag gaf je aan 4 letters om te willen zetten in een klein bereik. Kan je dan precies aangeven welke letters je wilt omzetten naar hoofdletters?
Of is het soms gewoon de bedoeling dat iedere kleine letter in een combinatie wordt omgezet naar hoofdletter??? Zo ja? Dan zou je hier een oplossing hebben...

Function ChCase(c As Range) As String
Dim sRegel As String, sLetter As String, sRegelNw As String
Dim i As Integer, sLetterNr As Integer
       
    sRegel = c.Value
    
    For i = 1 To Len(sRegel)
        sLetterNr = Asc(Mid(sRegel, i, 1))
        Select Case sLetterNr
            Case 97 To 122  'kleine letters a - z
                sLetter = Chr(sLetterNr - 32) 'hoofdletters is chr 65 - 90
            Case Else
                sLetter = Chr(sLetterNr) 'laat overige tekens met rust
        End Select
    sRegelNw = sRegelNw & sLetter
    Next i
    
    ChCase = sRegelNw
    
End Function

Plaats deze code in een standaard module van je VBE. Roep de functie aan in je worksheet dmv =ChCase(A1) (als je om te zetten combinatie in cel A1 staat).

Groet, Leo

 

[Ginger]

...en met een hele kleine uitbreiding van de functie, is tie volgens mij helemaal op maat voor je...
Ik heb de optionele variabele sAlleenDeze voor je toegevoegd. Als je nu de letters die je omgezet wilt hebben hier invult (tussen dubbele quotes geplaatst), wordt de rest van de letters over geslagen. Als je deze optie leeg laat, worden alle letters meegenomen.

Function ChCase(c As Range, [COLOR="Blue"]Optional sAlleenDeze As String = "abcdefghijklmnopqrstuvwxyz"[/COLOR]) As String
Dim sRegel As String, sLetter As String, sRegelNw As String
Dim i As Integer, sLetterNr As Integer
           
    sRegel = c.Value
    
    For i = 1 To Len(sRegel)
        sLetterNr = Asc(Mid(sRegel, i, 1))
        Select Case sLetterNr
            Case 97 To 122  'kleine letters a - z
                [COLOR="blue"]If InStr(1, sAlleenDeze, Chr(sLetterNr)) > 0 Then[/COLOR]
                    sLetter = Chr(sLetterNr - 32) 'hoofdletters is chr 65 - 90
                [COLOR="blue"]Else:
                    sLetter = Chr(sLetterNr)
                End If[/COLOR]
            Case Else
                sLetter = Chr(sLetterNr) 'laat overige tekens met rust
        End Select
    sRegelNw = sRegelNw & sLetter
    Next i
    
    ChCase = sRegelNw
    
End Function

De functie in je sheet ziet er dan zo uit: =ChCase(A1) of =ChCase(A1;"abgmop"). De letters mag je gewoon aan elkaar vast opgeven.

Groet, Leo

 

[Radjesh Klauke]

UCase heren. Wel even een pluim voor allen die met die mooie oplossingen zijn gekomen. IS GOED MAN!!!

 

[Ginger]

...een pluim voor allen...

Radjesh, Wij Leo, zien ons zelf nog steeds als enkelvoudig persoon... Maar bedankt voor je mooie compliment!:thumb:

Voor wat betreft je 'Ucase'... Tja, je hebt gelijk. Ik had deze functie wat omgebouwd van een functie die ik van de week voor m'n zoon heb geschreven. Hij had onterecht strafwerk gekregen en moest (ik vind de opdracht van z'n docent trouwens WEL leuk!) 10 regels overschrijven maar dan wel met steeds 1 letter opgeschoven. Dus a = b, b = c, c = d, enzovoorts. Hier heb ik dus ff vlug een functie voor gemaakt (voor de goed orde... Indien 1 van onze kinderen TERECHT straf heeft gekregen, wordt er uiteraard NIET geholpen!!!). Hier had ik de omzetting van de letters geregeld met een dubbele MOD-functie.

            Case 97 To 122  'kleine letters a - z
            'de dubbele mod-functie zorgt er voor dat 'z' + 1 'a' wordt...
                sLetter = Chr(97 + ((sLetterNr + iVerschuiving) Mod 97) Mod 26)

Tja, en met 'ombouwen' zie je dus wel 'ns wat dingen over het hoofd (Ucase).

Voorbeeld van zo'n omzetting:

Orgineel: Pop star Robbie Williams travelled to Sri Lanka with Unicef.
Omgezet: Qpq tubs Spccjf Xjmmjbnt usbwfmmfe up Tsj Mbolb xjui Vojdfg.

Groet, Leo

P.s. Als er liefhebbers zijn, kan ik die andere functie ook nog wel plaatsen...

 

[Ginger]

Radjesh, Nogmaals dank voor je terechte opmerking! Daardoor ben ik wat verder gaan nadenken en heb ik de functie een flink stuk vereenvoudigd.

Function ChCase(c As Range, Optional sAlleenDeze As String = "abcdefghijklmnopqrstuvwxyz") As String
Dim sRegel As String, sRegelNw As String, sLetter As String, sLetterNw As String
Dim i As Integer
           
    sRegel = c.Value
    
    For i = 1 To Len(sRegel)
        sLetter = Mid(sRegel, i, 1)
                If InStr(1, sAlleenDeze, sLetter) > 0 Then
                    sLetterNw = UCase(sLetter)
                Else:
                    sLetterNw = sLetter
                End If
        sRegelNw = sRegelNw & sLetterNw
    Next i
    
    ChCase = sRegelNw
    
End Function

De hele Case structuur bleek overbodig als je óók de Chr omzetting weglaat. En... hoe kleiner hoe mooier... Toch?

Groet, Leo

 

[Tsarevitsj]

Wow, hier is even flink wat werk verzet voor mijn nederige persoon

Leo, ik geef toch nog even antwoord op je eerste vragen;

Alle letters van het alfabet, al dan niet gecombineerd, worden gebruikt behalve de letter i en de letter e.

De gebruikte Range is ("H5:AI60")

En dan, met een jalourse blik op bovenstaand prachtig stuk werk, toch nog een laatste vraag. Ik heb in elke sheet, 18 stuks, de volgende code staan:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("AI5:AI60")) Is Nothing And Target.Count = 1 Then
    Inkleuren_01
End If
End Sub

Zodra er in deze kolom iets gebeurd, gaat de aangeroepen code de cursor verplaatsen en de ingevulde cellen van die rij een kleurtje geven, indien nodig.

Is het eventueel mogelijk jouw code hierin te "plakken" zodat bij elke invoer in de Range de letters direct worden omgezet?

Alvast heel erg bedankt voor het reageren, meedenken en oplossen :thumb:

Groet Tsarevitsj

 

[Ginger]

Tsarevitsj, Het invoegen van een functie in je code is een fluitje van een (euro)cent. Ik zou als ik jouw was je codeblokjes uit iedere sheet-module verwijderen en in de ThisWorkbook-module dit blokje plaatsen...

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    
    If Not Intersect(Target, Range("AI5:AI60")) Is Nothing And Target.Count = 1 Then
'        Inkleuren_01
        Target.Value = ChCase(Target, "abcdfghjklmnopqrstuvwxyz") 'e en i ontbreken!
    End If

End Sub

Dat houdt je code een stuk overzichtelijker en veranderingen doe je op slechts 1 plek in je VBE.

Groet, Leo

 

[Tsarevitsj]

Leo, het plaatsen van de code in de ThisWorkBook-module zal niet goed werken omdat er nog een aantal extra sheets zijn waarin deze code beslist niet uitgevoerd mag worden. Bovendien worden er, afhankelijk van de gegenereerde data, nog wat extra sheets aangemaakt die ook buiten deze code moeten blijven.

Ik heb net jouw code geplaatst in een sheet en die werkt maarrrr, alleen maar in de Range ("AI5:AI60") voor de voorgaande code, dus Inkleuren_01.

Jouw code zou moeten werken in de Range ("H5:AI60"), loop ik hier tegen een onoverkoombaar conflict op?

 

[Ginger]

Tsarevitsj, Dat had ik ff niet gezien.. Dat je 'te kleuren bereik' een andere is dan het 'om te zetten bereik'. Onoverkomelijk? Nee hoor! Maak er 2 aparte if-jes van.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    
    If Not Intersect(Target, Range("AI5:AI60")) Is Nothing And Target.Count = 1 Then
        Inkleuren_01
    End If

    If Not Intersect(Target, Range("H5:AI60")) Is Nothing And Target.Count = 1 Then
        Target.Value = ChCase(Target, "abcdfghjklmnopqrstuvwxyz") 'e en i ontbreken!
    End If

End Sub

(als voorbeeld ff met m'n eerdere code, maar dat kan je zelf wel aanpassen in je sheets)

Trouwens, De procedure 'Workbook_SheetChange' heeft als argument ook 'Sh As Object'. Hiermee kan je ook uitvragen op welke sheet je zit en daar vervolgens via een if of select case 'wel of niet' dingen gaat doen. Dan hou je namelijk nog steeds je code op slechts 1 plek.

Groet, Leo

 

[Tsarevitsj]

Leo, jouw code werkt perfect in de hele Range todat hij in de Range (kolom) van Inkleuren_01 komt.

De code herplaatst de ingevoerde letter(s) van klein naar groot of herplaatst simpel de letter als hij al groot is, Inkleuren_01 wordt dan actief maar zolang de cursor op dezelfde cel blijft staan, en dus steeds de letter herplaatst, komen beide codes in een oneindige lus. Inkleuren_01 reageert alleen maar als er in die bewuste Range "iets" verandert...

Ben al met een flink gevecht bezig geweest maar kan het maar niet oplossen

Btw, nog een vraagje, is het niet mogelijk om bij het openen van het Workbook en/of Sheet de CapsLock actief te maken en als het nodig is, voor b.v. een Userform in te vullen, CapsLock weer te deactiveren. Ik heb al wat gerommeld met Application.OnKey en Sendkeys maar ut lukt niet erg.

 

[Ginger]

Tsarevitsj, Het lijkt me het beste als je ff je bestandje als bijlage plaatst. Dan kan ik kijken waar het fout gaat. Nu is het allemaal een beetje vaag!

Groet, Leo

 

[Tsarevitsj]

Leo, hierbij een enkele sheet met uitleg daarin. Het hele bestand is namelijk leeg 3,3 MB en vol ± 7 MB.

Succes!

 

[Ginger]

Tsarevitsj, De reden van je oneindige lus komt door het feit dat je het e.e.a. in een change-event aanpast. Hierdoor roept de code zichzelf steeds aan. Probeer 'ns te testen met deze aanpassing....

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("AI5:AI60")) Is Nothing And Target.Count = 1 Then
        Inkleuren_01
    End If
    
    [COLOR="Blue"]Application.EnableEvents = False[/COLOR]
    If Not Intersect(Target, Range("H5:AI60")) Is Nothing And Target.Count = 1 Then
        Target.Value = ChCase(Target, "abcdfghjklmnopqrstuvwxyz") 'e en i ontbreken!
    End If
    [COLOR="blue"]Application.EnableEvents = True[/COLOR]

End Sub

In de gauwigheid kwam ik niet zo goed uit de code in module 1. Dus dit lijkt me de beste weg dat je zelf aan geeft of het nu wel werkt zoals je wilt.

Groet, Leo

 

[Tsarevitsj]

Leo, jouw laatste voorstel werkt goed maarrr, nu wordt alleen de Range (“AI5:AI60”) voor Inkleuren_01 niet meer ingekleurd.
Na wat gepuzzel heb ik zo opgelost;

Private Sub Worksheet_Change(ByVal Target As Range)

        Application.EnableEvents = False
    
    If Not Intersect(Target, Range("H5:AI60")) Is Nothing And Target.Count = 1 Then
        Target.Value = ChCase(Target, "abcdfghjklmnopqrstuvwxyz") 'e en i ontbreken!
    End If
    
        Application.EnableEvents = True
    
        Inkleuren_01
        
End Sub

En zo werkt het perfect.

Alleen is het nu wel zo dat Inkleuren_01 nu wat ongewenste bijwerkingen krijgt maar daar kom ik (hopelijk) wel uit.

Het is wel merkwaardig dat je de VBA skills zo snel kwijtraakt. Ik had dit progje 3 a 4 jaar geleden gemaakt en diegenen die er mee werken zijn er erg tevreden over. Het progje moest nu wat opgefrist worden en wat kleine aanpassingen ondergaan maar in de tussenliggende jaren heb ik erg weinig met VBA gedaan.
Nu zit ik naar duizenden regels code van mijzelf te kijken niet wetende wat ik er toen mee bedoelde.
Dan maar stap voor stap alles doorlopen en dan gaat het licht weer branden. Ik ga toch maar wat meer commentaar plaatsen, voor later

Leo, heel hartelijk bedankt voor jouw inbreng, ik ben er erg blij mee, top.:thumb:

 

[Tsarevitsj]

Leo, ik kom er toch niet helemaal uit. Inkleuren_01 en jouw code blijven maar overhoop liggen met elkaar.

Is er niet een mogelijkheid om jouw code, elke kleine letter omzetten naar een hoofdletter, te combineren door aan bepaalde letters/combinaties tevens een kleur toe te kennen aan die cel?