Wie verkette ich Texte bei variabler Zeilenanzahl?

Moin,

in der Tabelle sollen die Materialtexte die leider in unterschiedlich vielen Zeilen geschrieben sind in eine Zelle hinter dem Materialtext ausgegeben werden (wie beispielhaft manuell eingetragen in D2 und D7).Einfaches Verketten reicht nicht aus da eben die Anzahl der zu verkettenden Zeilen variiert. Gehe davon aus, dass VBA von Nöten ist (habe allerdings keine Erfahrung mit VBA)

Answer 1

[Iamiam]

ich würde das ganz handgestrickt konventionell lösen: erst mal mit =Max(B2:B9999) die höchste Wiederholungszahl ermitteln. Dann (Formel in D20):

1. =wenn(A19<>A20;C20
2. &wenn(A21=A20;C21;"")
3. &Wenn(A22=A20;C22;"")
4. &Wenn(A23=A20;C23;"")
5. &wenn(A24=A20;C24;"")
6. &wenn(A25=A20;C25;"")
7. &wenn(A26=A20;C26;"")
8. &wenn(A27=A20;C27;"")
9. &wenn(A28=A20;C28;"")
10. &Wenn(A29=A20;C29;"")
11. &Wenn(A30=A20;C30;"")
12. &wenn(A31=A20;C31;"")
13. &wenn(A32=A20;C32;"")
14. &wenn(A33=A20;C33;"")
15. &wenn(A34=A20;C34;"")
16. ;"")

Hast Du mehr als 15 aneinanderzuhängende Zellen, kannst Du das jederzeit analog erweitern Die Formel rauf- und runtergezogen ergibt Leer für gleiche Folgen unterhalb und den Einzelwert bei Einzelzeilen.

Solange es nicht riesige Wiederholungszahlen gibt (sagen wir mal Max=50 oder so), würde ich keine Klimmzüge machen: xl verkraftet solche Formeln ohne Probleme auch in großer Zahl.

Du kannst das hier kopieren und in xl in die Bearbeitungszeile(!, andernfalls verteilt xl das auf viele Zellen untereinander!) einfügen.

Je nach Geschmack die Umbrüche raus machen (in Libre Office Pflicht!), so dass ein längerer Formelteil in der Bearbeitungszeile sichtbar bleibt (zB je nach Bildschirmbreite immer 5-10 Formelteile pro Zeile belassen, in LibreOffice keinerlei Umbruch belassen!) Ich hab das hier der Formelklarheit wegen so angeordnet, ist am leichtesten zu korrigieren bzw anzupassen.

Probiers und frag ggf zurück!

Eine Makrolösung hätte den Nachteil, dass du jedesmal beim Öffnen nervige Warnmeldungen kriegst und die Inhalte aktivieren musst, unerfahrene Mitarbeiter trauen sich das möglicherweise nicht!

Comments

[hotdog12]

Wow ich danke dir! Du hast mir den Tag gerettet, das funktioniert hervorragend! :) 
Dir auch noch einen schönen Tag!

[Iamiam]

@hotdog12

Noch eine Anmerkung: Werden Zeilen neu eingefügt, müssen die Formeln über möglicherweise zig Zellen neu runtergezogen werden, da sonst Lücken auftreten können. Auch Zeilen direkt oberhalb eines neuen Items erfordern das, da es sonst zB heißt, =Wenn(A18<>A20;... anstatt (A19<>A20;...

Answer 2

[nobytree2]

Hallo,

warte einfach auf die Antwort von Suboptimierer, dem Chef in VBA.

Vorher Sicherungskopie der Excel-Datei erstellen! Makro ändert Inhalt, ggf. bei Fehlprogrammierung fehlerhaft!

Bis dahin zum Lernen: Öffne Excel, gehe auf Ansicht, Makros anzeigen, Makroname eingeben (beliebig)

Sub xx()

Dim InhaltNeu As String
Dim maxZeile, maxSpalte, Spalte_Start, Zeile_Start, x, y As Integer

maxZeile = 100
maxSpalte = 30
Spalte_Start = 3
Zeile_Start = 2

For x = 0 To maxZeile - 1
   
 InhaltNeu = ""
   
 For y = 0 To maxSpalte - 1
 
  If InhaltNeu = "" Then
 
    InhaltNeu = Cells(Zeile_Start + x, Spalte_Start + y).Value
 
  Else:
   If Cells(Zeile_Start + x, Spalte_Start + y).Value <> "" Then
        InhaltNeu = InhaltNeu + ", " + Cells(Zeile_Start + x, Spalte_Start + y).Value
   End If

  End If
 
 Next
   
Cells(Zeile_Start + x, Spalte_Start).Value = InhaltNeu

Next
  
End Sub

Comments

[nobytree2]

Sorry, ich habe hier die Spalten verkettet und nicht die Zeilen.

Answer 3

[Oubyi, UserMod Light]

Ich bin zwar nicht Suboptimierer, habe mich aber trotzdem mal an einem VBA-Code versucht.
Teste diesen Code mal ausführlich in einer Sicherheitskopie!:

Sub Verketten()
Dim Zelle As Range
Dim Bereich As Range
Dim Text As String
Dim EintragsZelle As Range

Text = ""
Set EintragsZelle = Range("D2")
Set Bereich = Range(Cells(2, 4), Cells(UsedRange.Rows.Count, 4))
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Bereich.ClearContents
For Each Zelle In Bereich
    If Zelle.Offset(0, -3).Value = Zelle.Offset(1, -3).Value Then
        Text = Text & " " & (Zelle.Offset(0, -1).Value)
    Else:
        Text = Text & " " & (Zelle.Offset(0, -1).Value)
        EintragsZelle.Value = Text
        Text = ""
        Set EintragsZelle = Zelle.Offset(1, 0)
    End If
Next Zelle
ErrorHandler: Application.ScreenUpdating = True
End Sub

Klappt es?

Woher ich das weiß: Berufserfahrung – IT-Administrator (i.R.)