Live-Forum - Die aktuellen Beiträge
Datum
Titel
25.04.2024 21:40:53
Excel Datenquelle aus dem Web mit Anmeldung?
25.04.2024 21:21:16
Zellkommentar in UserForm anzeigen und bearbeiten
25.04.2024 21:13:13
Kalenderwochen addieren
25.04.2024 21:06:05
Duplikate entfernen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1756to1760
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1756to1760
1756to1760
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Zelleninhalt in mehrer Zeilen

Zelleninhalt in mehrer Zeilen
07.05.2020 12:45:47
Marcel
Hallo Zusammen
Ich benötige mal eure Hilfe. Nach langer suche habe ich einfach nichts passendes für mein Anliegen gefunden und meine VBA Kenntenisse sind leider nicht so gut.
Die Grunddatei mit meinem Anfang habe ich als Beispiel mal hochgeladen.
https:\/\/www.herber.de/bbs/user/137345.xlsm
Ziel ist es am Ende eine Datei einzulesen und die Tabelle automatisch zu erstellen.
Hierbei sollen aus den Zeilen, wenn die Zellen aus Spalte A und B mehrer Einträge, welche durch Komma, Semikolon oder Zeilenumbruch getrennt sein können, einzelne Zeilen entstehen. Der Rest der Zeile soll einfach mitkopiert werden
In der Beispieldatei habe ich das schonmal gezeigt aufm ersten Sheet. Ziel wäre es aber das Ergebnis aufm zweiten Sheet auszugeben.
Es handelt zum Datensätze welche ohne die Trennung schon 15000 Zeilen haben.
Danke schonmal im voraus für eure Ideen

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zelleninhalt in mehrer Zeilen
07.05.2020 15:08:51
peterk
Hallo
Probier mal:

Option Explicit
Sub TabErstellen()
Dim cl As Range
Dim tmpStrA As Variant, tmpStrB As Variant
Dim lZ As Long, nZ As Long, i As Long, j As Integer
Dim QTab As Worksheet, zTab As Worksheet
Set QTab = Sheets("Sheet1")
Set zTab = Sheets("Sheet2")
lZ = QTab.Cells(QTab.Rows.Count, 1).End(xlUp).Row
For i = 1 To lZ
tmpStrA = Split(ReplStr(QTab.Cells(i, 1)), ",")
tmpStrB = Split(ReplStr(QTab.Cells(i, 2)), ",")
For j = 0 To UBound(tmpStrA)
nZ = nZ + 1
zTab.Cells(nZ, 1) = tmpStrA(j)
zTab.Cells(nZ, 2) = tmpStrB(j)
QTab.Range(QTab.Cells(i, 3), QTab.Cells(i, 8)).Copy zTab.Cells(nZ, 3)
Next j
Next i
End Sub
Function ReplStr(myString As String) As String
myString = Replace(myString, ";", ",")
myString = Replace(myString, vbCrLf, ",")
myString = Replace(myString, vbCr, ",")
myString = Replace(myString, vbLf, ",")
ReplStr = myString
End Function

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige