Frage von hotdog12, 53

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)

Hilfreichste Antwort - ausgezeichnet vom Fragesteller
von Iamiam, Community-Experte für Excel, 35

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!

Kommentar von hotdog12 ,

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

Kommentar von Iamiam ,

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;...

Antwort
von nobytree2, 38

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

Kommentar von nobytree2 ,

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

Expertenantwort
von Oubyi, Community-Experte für Excel, 19

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?

Keine passende Antwort gefunden?

Fragen Sie die Community

Weitere Fragen mit Antworten