tekst samenvoegen in één cel

[H3ndrik]

Beste Helpers,

Ik ben op zoek naar verkorte versie van onderstaande formule

=ALS(D1=1;C1&TEKEN(10);"")&ALS(D2=1;C2&TEKEN(10);"")&ALS(D3=1;C3&TEKEN(10);"")&ALS(D4=1;C4&TEKEN(10);"")&ALS(D5=1;C5&TEKEN(10);"")&ALS(D6=1;C6&TEKEN(10);"")

Zie bijlage ter verduidelijking.

Alvast bedankt voor het meedenken.

Henk

 

[AlexCEL]

Met formules lijkt het mij niet mogelijk om dit veel korter te maken, daar is VBA voor nodig.

Blijft over de vraag: waarom wil je 50 rijen in 1 cel? Dit lijkt mij totaal onwerkbaar worden.

 

[H3ndrik]

Beste AlexCEL,

Uiteindelijk blijven er van de 50 misschien 5 of 6 over. Deze wil ik in een cel omdat deze als een memo geëxporteerd wordt naar mijn Erp pakket.

Groet Henk

 

[edmoor]

Daar is dan inderdaad VBA voor nodig. Zet van de gewenste cel in de eigenchappen Terugloop aan en gebruik dan deze functie die je in een Module zet:

Function Memo(Bereik As Range) As String
    Dim cl As Range
    For Each cl In Bereik
        If Cells(cl.Row, cl.Column + 1) = 1 Then
            Memo = Memo & cl.Value & vbCrLf
        End If
    Next cl
End Function

Aanroep in je document:
=Memo(C1:C6)

 

[HSV]

@Edmoor,

dim cl as range

 If cl.offset(, 1) = 1 Then Memo = Memo & cl.Value & vbCrLf

 

[edmoor]

Kan ook uiteraard. Ik heb iets tegen het gebruik van Offset, maar da's persoonlijk.
Wat dim cl as range betreft voel ik me betrapt

 

[HSV]

Dat kan (ik vind het persoonlijk goed leesbaar), maar die 'i as long' hoort er niet in thuis.

edit: je aanpassing gelezen.

 

[edmoor]

Die was ik inderdaad vergeten weg te halen
Aangepast.

 

[HSV]

:thumb::thumb:

 

[H3ndrik]

Bedankt zover. Ziet er geweldig uit!

Is er echter nog een mogelijkheid dat hij continu berekend wordt? Het werkt nu alleen bij het verlaten van de cel. En ik wil graag dat hij aanpast op het moment dat er een 1 bijkomt of afgaat.

 

[edmoor]

Dat kan. Zet er dan een regeltje extra in:

Function Memo(Bereik As Range) As String
    Dim cl As Range
    [COLOR="#FF0000"]Application.Volatile[/COLOR]
    For Each cl In Bereik
        If Cells(cl.Row, cl.Column + 1) = 1 Then
            Memo = Memo & cl.Value & vbCrLf
        End If
    Next cl
End Function

 

[H3ndrik]

Bedankt Edmoor!

Ik ben helemaal geholpen hiermee.

Vriendelijk bedankt!

Henk.

 

[RogerReijkers]

=tekst.samenvoegen(b17;" ";d17;" ";f17)