PDA

Vollständige Version anzeigen : Automatische Verkettung ? Hilfe :)


Koonin
07.07.2014, 12:52
Moin Moin,

ich stehe gerade vor einer etwas kniffeligen Aufgabe.
Vielleicht könnt ihr mir ja helfen. Ich würde mich freuen.

Problemstellung:
Ich habe eine Exceltabelle, Zusatztexte für unseren Artikelstamm, mit ca. 9300 Zeilen.

Problem ist, dass die Zusatztexte in dieser Tabelle für verschiedene Abteilungen unterschiedlich sein können. (Siehe Anhang Grafik 1)

Das Kennzeichen für die Abteilung ist hier einmal ALXXX (Allgemein) und einmal EKXXX (Einkauf). Dazu kommen könnte noch QSXXX (Qualitätsmanagement) und NOXXX (NORMUNG).

Des Weiteren kann es sein, dass ein Artikel unterschiedlich viele Zeilen für Zusatztexte beansprucht. In der Grafik sehen wir jeweils nur 3 Zeilen Artikeltext, es kann aber auch x-beliebig viel sein.

Also zusammengefasst, ein Artikel, kann für vier unterschiedliche Abteilungen unterschiedliche Artikeltexte in unterschiedlicher Länge haben.

Mein Problem ist nun, dass ich ganz gerne alle Artikeltexte die über mehr als eine Zeile gehen zusammengefasst in einer Zelle haben möchte.
Ein Beispiel habe ich in der Grafik 2 mal dargestellt.

Wie kann ich das am besten lösen ?
Ich stehe vor einem wahrscheinlich großen Rätsel und komme nicht mehr weiter. Habe schon kombinierte S-/W-Verweise, Wenn dann usw. probiert. Alles nicht das richtige.

Ich habe auch im Anhang mal das Excel-Sheet zur Verfügung gestellt.

Ich würde mich über eine Lösung freuen.

Beste Grüße
Sascha

Hasso
07.07.2014, 17:44
Hallo Sascha,

hier mal eine VBA-Lösung:Option Explicit

Sub zusatztexte()

Dim rngZelle As Range
Dim intZeile As Integer
Dim intSpalte As Integer
Dim intLetzteZeile As Integer
Dim intZaehler As Integer
Dim intI As Integer

'letzte Zeile in Spalte C ermitteln:
intLetzteZeile = Worksheets("Tabelle1").Cells(Rows.Count, "C").End(xlUp).Row
With Worksheets("Tabelle1").Range("$A$1:$D$" & intLetzteZeile)
'Bildschirmaktualisierung aus:
Application.ScreenUpdating = False
On Error GoTo Fehler
'alle Zellen in Spalte C durchgehen:
For Each rngZelle In .Range("C1:C" & intLetzteZeile)
'wenn keine 1 in der Zelle steht und die Zelle darunter nicht leer ist:
If rngZelle <> 1 And rngZelle.Offset(0, 1) <> "" Then
'in Spalte D den bisherigen nehmen und den aktuellen + Zeilenvorschub anhängen:
.Cells(rngZelle.Row - rngZelle + 1, "D") = .Cells(rngZelle.Row - rngZelle + 1, "D") & Chr(10) & .Cells(rngZelle.Row, "D")
End If
Next rngZelle

'Tabelle auf alle Zellen filtern, deren Zahl in Spalte C >1 ist:
.AutoFilter
.AutoFilter Field:=3, Criteria1:=">1"
'Diese Zeilen löschen, übrig bleiben die mit der kumulierten Beschreibung:
.SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
Fehler:
'Bildschirmaktualisierung ein:
Application.ScreenUpdating = True
End Sub

Koonin
08.07.2014, 07:05
Moin Hasso,

hab vielen Dank für die schnelle und perfekte Lösung.
Hat alles wunderbar funktioniert.

*DAUMEN HOCH*

Gruß
Sascha