Копировать данные из ячейки одного листа в несколько ячеек на другом листе

230
user1234

У меня есть эта база данных, где я храню продажи. Я могу найти конкретные продажи путем фильтрации. Я хотел бы иметь кнопку, которая затем восстанавливает продажи в виде «квитанций» на другом листе.

Это мой код для этого, и он работает в определенной степени:

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

Это берет с первого листа

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

и выводит это на второй лист

123 456 A D B E USD GBP abc def

Проблема в том, что все товары хранятся в одной ячейке (столбец E, который соответствует DB_Sheet.Cells(i, 5)). Я хотел бы наклеить продукты по отдельности в разные строки на втором листе, как это

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

Я записал делать это вручную, и вот что у меня есть:

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

Мне нужна помощь в добавлении этого или чего-либо, что дает такие же результаты, в мой первый код.

0

1 ответ на вопрос

1
robinCTS

Намного проще игнорировать записанный макрос и создавать модификацию с нуля.

Из вашего записанного макроса кажется, что ваши продукты разделены запятыми, хотя данные вашего примера показывают обратное.

Итак, если предположить, что это действительно так, то следующий код изменен для «разделения» продуктов на отдельные строки:

'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

Ключом, конечно же, является Split()функция, которая преобразует строку продуктов, разделенных запятыми, в массив продуктов.

В этом случае достаточно просто вывести этот массив в соответствующий диапазон.

Обратите внимание, что если требуется другой разделитель, просто измените второй аргумент Split()функции.

Похожие вопросы