Opgelost On change zoeken naar leesteken

[skystormer]

Goedemorgen,

Na diverse pogingen wend ik mij tot de community.
Om een boom te maken om gegevens opvallender te krijgen zoek ik een macro welke zoekt naar tekens in een cel en deze op dezelfde rij kopieert bij een andere kolom.
Die wil ik in eerste instantie on change laten gebeuren echter daarna ook nog met een knop. (omdat de gegevens op 2 verschillende manieren kunnen worden gevoed. handmatig en via macro)

Met If InStr(1, cell.Value, ".") > 0 Then
Zoek ik of een "." voorkomt in een cel, echter dit kijkt niet naar het aantal punten. Ik wil onderscheidt maken naar de hoeveelheid punten.

Er kunnen tot 5 punten voorkomen in een cel. En de kolom waar ik het gegeven naar wil kopiëren is afhankelijk van het aantal punten in de cel.
Indien de waarde in een cel 1 punt bevat, dan moet de waarde gekopieerd worden naar Kolom B
Indien de waarde in een cel 2 punten bevat, dan moet de waarde gekopieerd worden naar Kolom C
Indien de waarde in een cel 3 punten bevat, dan moet de waarde gekopieerd worden naar Kolom D
Indien de waarde in een cel 4 punten bevat, dan moet de waarde gekopieerd worden naar Kolom E
Indien de waarde in een cel 5 punten bevat, dan moet de waarde gekopieerd worden naar Kolom F

Nu weet ik niet of het volgende mogelijk is, echter dat zou het afmaken. Dat alleen de waarden na het laatste puntje worden gekopieerd. Dus als waarde: 1.4.6.14, dat dan de waarde 14 wordt gekopieerd.

Bijgevoegd een voorbeeld bestand. Met hetgeen wat ik tot nog toe gevonden heb.

Ik hoop dat iemand mij hier in kan helpen.
Dank voor in ieder geval al te kijken.

 

[snb]

Gebruik splittocolumns

of

In C3:F13

=IF(LEN($B3)-LEN(SUBSTITUTE($B3;".";""))=COLUMN(C$1);$B3;"")

 

[skystormer]

Dag snb,

Dank je voor de response. Helaas kan ik het niet met een excel formule oplossen. Dit vanwege het aantal rijen variabel is. Dit kan 3 rijen zijn of soms 140. (overzicht waar ik dit in wil verwerken moet printvriendelijke blijven.

Echter ben aan het kijken of ik met:
level = UBound(Split(cel.Value, "."))
Iets kan bereiken.

 

[snb]

Dank je voor de response. Helaas kan ik het niet met een excel formule oplossen. Dit vanwege het aantal rijen variabel is. Dit kan 3 rijen zijn of soms 140. (overzicht waar ik dit in wil verwerken moet printvriendelijke blijven.

Dit 'argument' is onjuist.
Wat is de zin van deze excercitie ?

UDF:

Function F_snb(c00)
   F_snb = Split(c00, ".")(UBound(Split(c00, ".")))
End Function

In C3
=F_snb(B3)

 

[Warme bakkertje]

Dit zou er eentje kunnen zijn.

Sub tst()
    For Each cl In Range("H2", Range("H" & Rows.Count).End(xlUp))
        Count = Len(cl.Value) - Len(Replace(cl.Value, ".", ""))
        Cells(cl.Row, Count + 1) = Split(cl.Value, ".")(UBound(Split(cl.Value, ".")))
    Next
End Sub

 

[skystormer]

Sub VerwerkHiërarchieMetVoorwaarde()
    Dim ws As Worksheet
    Dim cel As Range
    Dim onderdelen() As String
    Dim niveau As Integer
    Dim laatsteDeel As String
    Dim i As Long

    Set ws = ThisWorkbook.Sheets(1) ' Pas eventueel aan naar je sheetnaam

    For i = 2 To ws.Cells(ws.Rows.Count, "H").End(xlUp).Row
        Set cel = ws.Cells(i, "H")

        If Trim(cel.Value) <> "" Then
            onderdelen = Split(cel.Value, ".")
            niveau = UBound(onderdelen) ' Aantal punten = niveau
            laatsteDeel = onderdelen(niveau)

            Select Case cel.Value
                Case "1"
                    ws.Cells(i, "A").Value = laatsteDeel
                Case Else
                    If niveau >= 1 Then
                        ws.Cells(i, niveau + 1).Value = laatsteDeel
                    End If
            End Select
        End If
    Next i
End Sub

Ik heb het met deze code aan kunnen passen.
Heb copilot een kans gegeven en was aangenaam verrast naar de opties in deze.

Dank je voor de opties. Helaas gaat het idee op de langere termijn. Vanwege een aantal zaken welke niet opgelost kunnen worden. (omdat het systeem waar vervolgens dit in verwerkt gaat worden, met waarden langer dan 10 niet kan werken. Terwijl het origineel deze dus wel heeft. Iets wat we hier zelf moeten oplossen voor ik hier verder mee kan gaan.

 

[Warme bakkertje]

En wat denk je dan dat mijn code doet in 4 regels ???

 

[skystormer]

Sorry Warme bakkertje.
Met de 4 regels van je kom ik er niet.
Als ik jou code 100% overneem in het testbestand, dan krijg ik:

het subscript valt buiten het bereik

o.a.: omdat cl geen declaratie heeft zo ver ik kan zien. Deze aan een range gehangen, echter geeft nog steeds dit probleem.

Ook als ik je code als volgt aanpas krijg ik nog dezelfde foutmelding.

Sub tst()
    Dim cl As Range
    Dim Count As Long
    Dim parts() As String

    For Each cl In Range("H2", Range("H" & Rows.Count).End(xlUp))
        Count = Len(cl.Value) - Len(Replace(cl.Value, ".", ""))
        parts = Split(cl.Value, ".")
        Cells(cl.Row, Count + 1).Value = parts(UBound(parts))
    Next
End Sub

 

[Warme bakkertje]

Ik weet niet waarom je die parts regel erbij haalt aangezien deze totaal overbodig is????
Maar als je

Dim parts As Variant

gebruikt is je probleem opgelost.