Import Experte gesucht...

Folgendes Problem. Siehe Datei

Die Datei https://www.herber.de/bbs/user/45304.xls wurde aus Datenschutzgründen gelöscht

Ich hab in einer Datei eine Tabelle mit Vorgängen (eindeutige ID1 mal vorhanden)
Im 2. Tabellenblatt gibt es zu jedem Vorgang mehrere Kommentare
z.B. Im 1. Tabellenblatt gibt es den Vorgang mit der ID 50017. Zu diesem Vorgang gibt es mehrere Kommentare auf dem 2. Tabellenblatt, 5 Kommentare mit der ID 50017
Jede Zeile stellt einen Kommentar zu einem bestimmten Vorgang da. In meinem Beispiel gibt es zu dem Vorgang 50017 insgesamt 5 Kommentare.
Ich möchte nun alle Feldinformationen auf dem 2. Tabellenblatt dem entsprechenden Vorgang im 1. Tabellenblatt zuordnen. Am besten wäre es das alle 5 Zeilen die zum Vorgang 50017 gehören in ein Feld auf das 1. Tabellenblatt kopiert werden. Dafür ist die Spalte S im 1. Tabellenblatt vorgesehen.
Am Ende soll im 1. Tabellenblatt Spalte S zu Vorgang 50017 alle 5 Einträge aus dem 2. Tabellenblatt auftauchen.
Im Beispiel ist die Liste relativ klein. Doch die Originalliste beinhaltet mehrere hundert solcher Vorgänge
Kann man das irgendwie automatisieren?
Wäre mir eine große Hilfe
Danke
Julia

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Function BereichVerketten(Rng As Range, Optional strSpace As String) As String 'Verketten über Bereich Dim C As Range Application.Volatile For Each C In Rng If C "" Then BereichVerketten = BereichVerketten & C & strSpace Next BereichVerketten = Left(BereichVerketten, Len(BereichVerketten) - Len(strSpace)) End Function

Private Sub Worksheet_Activate() Dim vntKommentar, lngRow As Long, j As Long, strKommentar As String vntKommentar = Sheets("Kommentar").Range("A1").CurrentRegion With Sheets("vorgang") For lngRow = 2 To .Cells(Rows.Count, 1).End(xlUp).Row strKommentar = "" For j = 2 To UBound(vntKommentar, 1) If vntKommentar(j, 2) = .Cells(lngRow, 1) Then _ strKommentar = strKommentar & vntKommentar(j, 8) & vbLf & vbLf Next j If Len(strKommentar) > 0 Then .Cells(lngRow, 19) = Left(strKommentar, Len(strKommentar) - 2) Else .Cells(lngRow, 19) = "" End If Next lngRow End With End Sub

Private Sub Worksheet_Activate() Dim vntKommentar, lngRow As Long, j As Long, strKommentar As String, i As Integer vntKommentar = Sheets("Kommentar").Range("A1").CurrentRegion With Sheets("vorgang") For lngRow = 2 To .Cells(Rows.Count, 1).End(xlUp).Row strKommentar = "" For j = 2 To UBound(vntKommentar, 1) If vntKommentar(j, 2) = .Cells(lngRow, 1) Then For i = 1 To UBound(vntKommentar, 2) strKommentar = strKommentar & vntKommentar(j, i) & ", " Next i strKommentar = Left(strKommentar, Len(strKommentar) - 2) & vbLf & vbLf End If Next j If Len(strKommentar) > 0 Then .Cells(lngRow, 19) = Left(strKommentar, Len(strKommentar) - 2) Else .Cells(lngRow, 19) = "" End If Next lngRow End With End Sub

Beliebteste Forumthreads (12 Monate)

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread