Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Mehrere Begriffe in einer Zelle in einzelne Zellen aufteilen.
#1
Hallo liebes Forum,

mein Problem stellt sich wie folgt da. Ich habe eine größere Excelliste mit mehreren Datensätzen (Zeilen) und Spalten (versch Attribute).

In einigen Datensätzen also Zeilen stehen in einer Spalte mit der Funktion: (ALT+Enter) also mit dem Zeilenumbruch getrennt mehrere Wörter. 

Für jedes Dieser Wörter würde ich gern eine neue Zeile angelegt haben mit den gleichen Einträgen der Attribute wie in der Ursprungszeile wo sie herkommen. Zur veranschlaulischung meines Problems lade ich mal ein Bild und eine Beispieldatei hoch.

Meine konkrete Frage ist jetzt hier kann man dies einfacher hinbekommen als manuelle über Zelle kopierne (in der die Wörter untereinander stehen), dann mit "Text in Spalten" --> bei trennen "Alt Enter 101" angeben. Dann manuell die Ursprungszeile so oft kopieren wie das wort vorkommt und die geänderten Spalten (attribute) ergänzen.?!

Bild:

[url=
Dateiupload bitte im Forum! So geht es: Klick mich!
]
Datei:  


Danke mfg


Angehängte Dateien
.xlsx   beispieldatei.xlsx (Größe: 10,06 KB / Downloads: 5)
Antworten Top
#2
(01.08.2016, 10:07)bsgVeritas schrieb: Hallo liebes Forum,

Datei:  wie kann ich dateien hochladen ? oder muss ich das über einen link machen ?

Danke mfg

Hallo bsg

so
Gruß Conny :)
_______________________________________________________________

Die Summe der Intelligenz auf unserem Planeten ist konstant, aber die Bevölkerung wächst!
Antworten Top
#3
Ist das mit excel vielleicht so einfach nicht möglich und kommt an vba nicht vorbei ? 

Kann das einer schon sagen ?  Ich versuchs mal mit makro aufzeichnen ..
Antworten Top
#4
Hi bsg,

hast du Connys Antwort auf deine Frage bzgl. Hochladens einer Datei nicht gelesen?

Das Wort "So" ist farbig und ein anklickbarer Link. Lies dir doch bitte den dahinter stehenden Beitrag durch.
Gruß Günter
Jeder Fehler erscheint unglaublich dumm, wenn andere ihn begehen.
angebl. von Georg Christoph Lichtenberg (1742-1799)
Antworten Top
#5
(01.08.2016, 12:03)bsgVeritas schrieb: Ist das mit excel vielleicht so einfach nicht möglich und kommt an vba nicht vorbei ? 

Kann das einer schon sagen ?  Ich versuchs mal mit makro aufzeichnen ..

Code:
Option Explicit

Sub AltEnterSplit()

Dim sInp() As String
Dim sTeileNr() As String
Dim sAnz() As String
Dim delLineNo() As Long
Dim rg As Range
Dim cell As Range
Dim rgBezeichnung As Range
Dim wks As Worksheet
Dim i As Integer, j As Integer
Dim newLine As Range
Dim oldLine As Range
Const ListWidth = 17
Const colBez = 8



   On Error GoTo AltEnterSplit_Error

   ' If neceessary adjust codename of worksheet
   Set wks = Tabelle1
   Set rgBezeichnung = wks.Range(wks.Cells(2, colBez), wks.Cells(2, colBez).End(xlDown))
   j = 0
   Application.ScreenUpdating = False


   For Each cell In rgBezeichnung

       sInp = Split(cell.Value, vbLf)

       If LBound(sInp) = UBound(sInp) Then
           ' Do nothing
       Else

           sTeileNr = Split(cell.Offset(0, -1).Value, vbLf)
           sAnz = Split(cell.Offset(0, 1).Value, vbLf)

           ' add as many new lines as entries in the array
           For i = LBound(sInp) To UBound(sInp)
               ' Add single line
               Set rg = Range("A1").End(xlDown).Offset(1, 0)
               Set newLine = wks.Range(rg, wks.Cells(rg.Row, ListWidth))
               Set oldLine = wks.Range(Cells(cell.Row, 1), wks.Cells(cell.Row, ListWidth))
               newLine.Value = oldLine.Value
               newLine.Cells(1, colBez).Value = sInp(i)

               ' If adjacent cells don't have the same number of lines just ignore it
               On Error Resume Next
               newLine.Cells(1, colBez - 1).Value = sTeileNr(i)
               newLine.Cells(1, colBez + 1).Value = sAnz(i)
               On Error GoTo AltEnterSplit_Error
           Next i

           ' Collect the line to delete
           ReDim Preserve delLineNo(j)
           delLineNo(j) = cell.Row
           j = j + 1

       End If

   Next cell

   For i = UBound(delLineNo) To LBound(delLineNo) Step -1
       Rows(delLineNo(i)).Delete
   Next

   On Error GoTo 0
   Exit Sub

AltEnterSplit_Error:

   MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure AltEnterSplit of Modul Modul1"

End Sub
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste