Kopieren Sie Daten aus einer Blattzelle in mehrere Zellen in einem anderen Blatt

324
user1234

Ich habe diese Datenbank, in der ich Verkäufe speichere. Ich kann bestimmte Verkäufe durch Filtern finden. Ich hätte gerne eine Schaltfläche, die den Umsatz als "Quittungen" in einem anderen Blatt neu generiert.

Dies ist mein Code dafür und funktioniert bis zu einem gewissen Grad:

Dim i As Long Dim col As Integer Dim DB_Sheet, Rec_Sheet As Object  Set DB_Sheet = ThisWorkbook.Worksheets("Sheet3") Set Rec_Sheet = ThisWorkbook.Worksheets("Sheet2") col = 1 For i = 2 To DB_Sheet.Range("A" & Rows.Count).End(xlUp).Row If DB_Sheet.Rows(i).Hidden = False Then Rec_Sheet.Cells(1, col) = DB_Sheet.Cells(i, 7) Rec_Sheet.Cells(2, col) = DB_Sheet.Cells(i, 8) Rec_Sheet.Cells(3, col) = DB_Sheet.Cells(i, 6) Rec_Sheet.Cells(4, col) = DB_Sheet.Cells(i, 9) Rec_Sheet.Cells(5, col) = DB_Sheet.Cells(i, 5) col = col + 1 End If Next i

Es nimmt dies vom ersten Blatt

BUYER SELLER DATE PRODUCTS CURRENCY A B 123 abc USD D E 456 def GBP

und gibt dies auf dem zweiten Blatt aus

123 456 A D B E USD GBP abc def

Das Problem ist, dass die Produkte alle in einer Zelle (Spalte gespeichert sind E, die der entspricht DB_Sheet.Cells(i, 5)). Ich möchte die Produkte einzeln in verschiedenen Reihen auf das zweite Blatt kleben

123 456 A D B E USD GBP a d b e c f

Ich habe manuell aufgenommen und das ist was ich habe:

Range("E2").Select Selection.TextToColumns Destination:=Range("S2"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _ :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _ Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), TrailingMinusNumbers:=True Range("S2:AB2").Select Selection.Copy Range("S3").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True Range("S2:AB2").Select Application.CutCopyMode = False Selection.Delete Shift:=xlUp

Ich brauche Hilfe, wenn Sie dies oder etwas, das die gleichen Ergebnisse erzielt, zu meinem ersten Code hinzufügen.

0

1 Antwort auf die Frage

1
robinCTS

Es ist viel einfacher, das aufgezeichnete Makro zu ignorieren und die Modifikation von Grund auf zu erstellen.

In Ihrem aufgezeichneten Makro sieht es so aus, als wären Ihre Produkte durch Kommas getrennt, auch wenn Ihre Beispieldaten etwas anderes zeigen.

Vorausgesetzt, dass dies tatsächlich der Fall ist, wird der Code so geändert, dass die Produkte in separate Zeilen "aufgeteilt" werden:

'v0.1.0 Dim i As Long Dim col As Integer Dim DB_Sheet, Rec_Sheet As Object  Set DB_Sheet = ThisWorkbook.Worksheets("Sheet3") Set Rec_Sheet = ThisWorkbook.Worksheets("Sheet2") col = 1 For i = 2 To DB_Sheet.Range("A" & Rows.Count).End(xlUp).Row If DB_Sheet.Rows(i).Hidden = False Then Rec_Sheet.Cells(1, col) = DB_Sheet.Cells(i, 7) Rec_Sheet.Cells(2, col) = DB_Sheet.Cells(i, 8) Rec_Sheet.Cells(3, col) = DB_Sheet.Cells(i, 6) Rec_Sheet.Cells(4, col) = DB_Sheet.Cells(i, 9) Dim varProducts As Variant varProducts = Split(DB_Sheet.Cells(i, 5).Value2, ",") Rec_Sheet.Cells(5, col).Resize(RowSize:=UBound(varProducts) - LBound(varProducts) + 1).Value2 _ = WorksheetFunction.Transpose(varProducts) col = col + 1 End If Next i

Der Schlüssel ist natürlich die Split()Funktion, die die Zeichenfolge von durch Kommas getrennten Produkten in ein Array von Produkten konvertiert.

Es ist dann eine einfache Sache, dieses Array in den entsprechenden Bereich auszugeben.

Wenn ein anderes Trennzeichen erforderlich ist, ändern Sie einfach das zweite Argument der Split()Funktion.

Verwandte Probleme