Thema Datum  Von Nutzer Rating
Antwort
Rot Mehrere Einträge zu einer Artikelnummer verketten
07.06.2019 11:12:06 Sarah
NotSolved
07.06.2019 18:57:54 Gast56370
NotSolved
08.06.2019 16:57:02 Gast97933
NotSolved

Ansicht des Beitrags:
Von:
Sarah
Datum:
07.06.2019 11:12:06
Views:
59
Rating: Antwort:
  Ja
Thema:
Mehrere Einträge zu einer Artikelnummer verketten

Hallo Zusammen,

ich habe folgendes Problem:

Habe eine Tabelle und in Spalte A stehen Artikelnummern, diese können häufiger vorkommen, in Spalte C stehen verschiedene Nummern die dazugehören.

Nun möchte ich gerne alle Nummern aus Spalte C die zu der gleichen Artikelnummer in Spalte A gehören verketten und mit Semikolon trennen und gerne in Spalte F schreiben lassen. Siehe folgendes Bild:

 

Ich habe bereits einen Code programmiert, da es noch einige Sachen zu beachten gibt, dieser läuft auch durch, aber es tut sich leider nichts, bräuchte daher Hilfe bei dem oben geschilderten Grundproblem.

 

Hier trotzdem mein Code nochmal:

Sub Filter1()
'
' Filter1 Makro
'

'
Application.ScreenUpdating = False

Application.EnableEvents = False

    Sheets("Tabelle1").Select

    Dim J As Long
    Dim jmax As Long
    jmax = Range("A2").End(xlDown).Row
   
    For J = 2 To jmax
        On Error Resume Next

    ActiveSheet.Range("$A$1:$E$51336").AutoFilter Field:=1, Criteria1:= _
        "J" 
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Zwischenspeicher").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets("Zwischenspeicher").Select

    ActiveSheet.Range("$A$1:$E$200").AutoFilter Field:=5, Criteria1:= _
        "#NV"

    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Zwischenspeicher2").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets("Zwischenspeicher2").Select
    Range("C2:C200").Select
    Selection.Copy
    Range("F3").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True

    Range("F2").Select
    ActiveCell.FormulaR1C1 = _
        "=R[1]C&"";""&R[1]C[1]&"";""&R[1]C[2]&"";""&R[1]C[3]&"";""&R[1]C[4]&"";""&R[1]C[5]&"";""&R[1]C[6]"

    Range("F2").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets("Endstand").Select

    Range("D2").Select
    Cells(J, 4) = WorksheetFunction.VLookup(Cells(J, 1), Sheets("Zwischenspeicher2").Range("A:F"), 6, False)
    Cells(J, 4).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Sheets("Zwischenspeicher").Select
    Cells.Select
    Selection.Delete Shift:=xlUp

    Sheets("Zwischenspeicher2").Select
    Cells.Select
    Selection.Delete Shift:=xlUp

    Sheets("Tabelle1").Select
    ActiveSheet.ShowAllData

    Next J
    
Application.CutCopyMode = False
 
Application.ScreenUpdating = True

Application.EnableEvents = True


End Sub

 

Ich hoffe ihr könnt mir helfen, vielen Dank schon mal! :)

Liebe Grüße

Sarah


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst genau und ausführlich
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
  • Bitte markieren Sie Ihre Anfrage als erledigt wenn Ihnen geholfen wurde
Thema: Name: Email:

 
 

Thema Datum  Von Nutzer Rating
Antwort
Rot Mehrere Einträge zu einer Artikelnummer verketten
07.06.2019 11:12:06 Sarah
NotSolved
07.06.2019 18:57:54 Gast56370
NotSolved
08.06.2019 16:57:02 Gast97933
NotSolved