Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1732to1736
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
Inhaltsverzeichnis

Spezifische Feldkombinationen auflisten lassen

Spezifische Feldkombinationen auflisten lassen
07.01.2020 21:42:14
Martin
Hallo in die Runde,
nach der tollen Hilfe über den Jahreswechsel - vielen Dank insbesondere an Werner und Thorsten -, hoffe ich, noch einmal geholfen zu bekommen. Ich benötige aus einer Artikel- und Variantenauflistung zweierlei Feldkombinationen ausgespielt. Folgend eine Beispieldatei, die das hoffentlich veranschaulicht: https://www.herber.de/bbs/user/134233.xlsx
Die benötigten Listen würde ich dann als CSV exportieren, das heißt das Ergebnis muss nicht besonders "schön" vorliegen. Im Bestfall kann aber auf Power Query verzichtet werden.
Habt ihr eine Idee, wie das zu lösen ist?
Danke und viele Grüße,
Martin

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spezifische Feldkombinationen auflisten lassen
08.01.2020 07:35:37
Luschi
Hallo Martin,
hier mal mein Versuch zur 2. Teilaufgabe:
https://www.herber.de/bbs/user/134236.xlsm
Gruß von Luschi
aus klein-Paris
AW: Spezifische Feldkombinationen auflisten lassen
08.01.2020 10:11:49
Werner
Hallo Martin,
hier der Code von Luschi mit der Erweiterung bezüglich Problem 1.
Da ich nicht wusste wo genau hin mit den Daten, habe ich mich an die Vorlage gehalten.
Auflistung der Artikel in Zelle A1, die folgende Zusammenstellung in Zelle A3.
Option Explicit
Sub MachMal_2()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rg1 As Range, rg2 As Range, rg3 As Range
Dim s1 As String, s2 As String, s3 As String, i As Long
Set ws1 = ThisWorkbook.Worksheets("Modelle")
Set ws2 = ThisWorkbook.Worksheets("CSV_2")
ws2.Cells.Clear
With ws1
For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If s3 = vbNullString Then
s3 = .Cells(i, 1)
Else
s3 = s3 & ";" & .Cells(i, 1)
End If
Next i
If Not s3 = vbNullString Then
ws2.Range("A1") = s3
End If
End With
Set rg1 = ws1.Range("A2")
Set rg2 = ws2.Range("A3")
Do While rg1.Value  ""
'Variante 1 - einzeln
s1 = "": s2 = ""
s1 = "Artikel=" & rg1.Value & "|Variante=" & rg1.Offset(0, 1).Value & _
"|Einzeln oder paarweise=einzeln"
rg2.Value = s1: rg2.Offset(0, 1).Value = rg1.Offset(0, 2).Value
'Variante 1 - paar
Set rg2 = rg2.Offset(1, 0)
s1 = "Artikel=" & rg1.Value & "|Variante=" & rg1.Offset(0, 1).Value & _
"|Einzeln oder paarweise=paarweise"
rg2.Value = s1: rg2.Offset(0, 1).Value = rg1.Offset(0, 3).Value
If rg1.Offset(0, 4).Value  "" Then
'Variante 2 - einzeln
Set rg2 = rg2.Offset(1, 0)
s1 = "Artikel=" & rg1.Value & "|Variante=" & rg1.Offset(0, 4).Value & _
"|Einzeln oder paarweise=einzeln"
rg2.Value = s1: rg2.Offset(0, 1).Value = rg1.Offset(0, 5).Value
'Variante 2 - paar
Set rg2 = rg2.Offset(1, 0)
s1 = "Artikel=" & rg1.Value & "|Variante=" & rg1.Offset(0, 4).Value & _
"|Einzeln oder paarweise=paarweise"
rg2.Value = s1: rg2.Offset(0, 1).Value = rg1.Offset(0, 6).Value
End If
Set rg1 = rg1.Offset(1, 0)
Set rg2 = rg2.Offset(1, 0)
Loop
Set rg1 = Nothing: Set rg2 = Nothing
Set ws1 = Nothing: Set ws2 = Nothing
End Sub
@Luschi
Keine Zeit mehr gehabt? Im Vergleich zu deiner Problemlösung ist das ja gar nix.
Gruß Werner
Anzeige
AW: Spezifische Feldkombinationen auflisten lassen
08.01.2020 17:01:47
Martin
Hallo Werner, hallo Luschi,
vielen Dank für eure Lösung, das sieht sehr gut aus. Ich habe in Luschis Datei noch Werners Code ergänzt und mit den Beispieldaten funktioniert es wunderbar. Ich werde morgen mehrere Sets von Realdaten durchlaufen lassen und bin sehr gespannt.
Vielen Dank und einen schönen Abend
Martin
AW: Spezifische Feldkombinationen auflisten lassen
09.01.2020 13:53:08
Martin
Hallo Werner und Luschi,
die Datei funktioniert super und ich kann sehr schön damit arbeiten. Vielen Dank.
Es ist noch eine Anforderung hinzu gekommen. Das konnte ich händisch umsetzen, aber vielleicht findet ihr eine Lösung dafür, die dann z.B. gleich in A2 das folgende gewünschte Ergebnis ausgibt:
Auch die Varianten 1 und 2 sollen zusammengefasst in einer Zelle semikolonsepariert und zusätzlich aufsteigend sortiert gelistet werden. Zu beachten ist, dass anders als im Beispiel gezeigt, bei Realdaten in den Varianten Duplikate vorkommen, die bereinigt werden sollen. Leere Felder, wie sie in der Spalte von Variante 2 ebenfalls vorkommen, sollen in dieser Auflistung nicht berücksichtigt werden.
Anhand der Beispieldaten stünde somit in einer Zelle (z.B. A2): 1A;1B;1C;2A;2B;1D;1E usw.
Seht ihr eine Möglichkeit der Umsetzung?
Danke und viele Grüße,
Martin
Anzeige
AW: Spezifische Feldkombinationen auflisten lassen
09.01.2020 14:51:44
Luschi
Hallo Martin,
Sorry, aber Deine Angaben sind mir zu theoretisch. Mach's doch wie beim 1. Mal:
- lade eine neue Testdatei hoch
- mit den neuen Ausgangsdaten
- und zeige als Ansatz, wie die Ergebnisdaten jetzt aussehen sollen
- unter der Voraussetzung von Duplikaten, Leerfeldern usw.
Gruß von Luschi
aus klein-Paris
AW: Spezifische Feldkombinationen auflisten lassen
10.01.2020 09:02:55
Martin
Hallo Luschi,
damit hast du natürlich Recht. Statt das aufzuschreiben hätte ich in der Zeit auch einfach die Beispieldatei ergänzen können. Die findet ihr nun hier: https://www.herber.de/bbs/user/134294.xlsx
Ist es so besser verständlich?
Viele Grüße,
Martin
Anzeige
AW: Spezifische Feldkombinationen auflisten lassen
10.01.2020 10:59:12
Werner
Hallo Martin,
teste mal:
Option Explicit
Sub MachMal_2()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rg1 As Range, rg2 As Range, rg3 As Range
Dim s1 As String, s2 As String, s3 As String, i As Long
Dim loLetzte As Long
Set ws1 = ThisWorkbook.Worksheets("Modelle")
Set ws2 = ThisWorkbook.Worksheets("CSV_2")
ws2.Cells.Clear
With ws1
For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
If s3 = vbNullString Then
s3 = .Cells(i, "A")
Else
s3 = s3 & ";" & .Cells(i, "A")
End If
Next i
If Not s3 = vbNullString Then
ws2.Range("A1") = s3
End If
s3 = ""
'Variante 1 und Variante 2 in Spalte O kopieren
.Range("B2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row).Copy
.Range("O1").PasteSpecial Paste:=xlPasteValues
.Range("E2:E" & .Cells(.Rows.Count, "E").End(xlUp).Row).Copy
.Range("O" & .Cells(.Rows.Count, "O").End(xlUp).Offset(1).Row).PasteSpecial _
Paste:=xlPasteValues
'Varianten in Spalte O sortieren
loLetzte = .Cells(.Rows.Count, "O").End(xlUp).Row
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("O1"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With .Sort
.SetRange Range("O1:O" & loLetzte)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
Application.CutCopyMode = False
'Duplikate in Spalte O entfernen
.Columns("O:O").RemoveDuplicates Columns:=1, Header:=xlNo
'Daten in Spalte O verketten
For i = 1 To .Cells(.Rows.Count, "O").End(xlUp).Row
If s3 = vbNullString Then
s3 = .Cells(i, "O")
Else
s3 = s3 & ";" & .Cells(i, "O")
End If
Next i
If Not s3 = vbNullString Then
ws2.Range("A2") = s3
End If
'Spalte O leeren
.Columns("O").ClearContents
End With
Set rg1 = ws1.Range("A2")
Set rg2 = ws2.Range("A4")
Do While rg1.Value  ""
'Variante 1 - einzeln
s1 = "": s2 = ""
s1 = "Artikel=" & rg1.Value & "|Variante=" & rg1.Offset(0, 1).Value & _
"|Einzeln oder paarweise=einzeln"
rg2.Value = s1: rg2.Offset(0, 1).Value = rg1.Offset(0, 2).Value
'Variante 1 - paar
Set rg2 = rg2.Offset(1, 0)
s1 = "Artikel=" & rg1.Value & "|Variante=" & rg1.Offset(0, 1).Value & _
"|Einzeln oder paarweise=paarweise"
rg2.Value = s1: rg2.Offset(0, 1).Value = rg1.Offset(0, 3).Value
If rg1.Offset(0, 4).Value  "" Then
'Variante 2 - einzeln
Set rg2 = rg2.Offset(1, 0)
s1 = "Artikel=" & rg1.Value & "|Variante=" & rg1.Offset(0, 4).Value & _
"|Einzeln oder paarweise=einzeln"
rg2.Value = s1: rg2.Offset(0, 1).Value = rg1.Offset(0, 5).Value
'Variante 2 - paar
Set rg2 = rg2.Offset(1, 0)
s1 = "Artikel=" & rg1.Value & "|Variante=" & rg1.Offset(0, 4).Value & _
"|Einzeln oder paarweise=paarweise"
rg2.Value = s1: rg2.Offset(0, 1).Value = rg1.Offset(0, 6).Value
End If
Set rg1 = rg1.Offset(1, 0)
Set rg2 = rg2.Offset(1, 0)
Loop
Set rg1 = Nothing: Set rg2 = Nothing
Set ws1 = Nothing: Set ws2 = Nothing
End Sub
Gruß Werner
Anzeige
AW: Spezifische Feldkombinationen auflisten lassen
13.01.2020 17:09:13
Martin
Hallo Werner,
funktioniert super und ich konnte den Code auch selbst noch anpassen. Vielen lieben Dank.
Danke auch an Luschi.
Viele Grüße,
Martin
schätze die Tastatur ist defekt....
13.01.2020 14:58:15
Werner
...oder das I-Net ist down.
Gruß Werner

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige