Блог

Я новичок в макросах Excel и пытаюсь копировать данные с одного листа на другой. На первом листе у меня есть данные, как показано ниже:

 Id Name Salary 1 AAA 1000 2 BBB 5000 3 CCC 6000  

В другом листе 2 у меня есть кнопка, и по ее нажатию мне нужно сгенерировать данные в формате ниже (своего рода форма) для всех записей из листа 1.

 Id Date (Today's Date) Name Salary --Few More Specific Data  

В моем случае по нажатию кнопки мне нужно, чтобы вышеуказанная форма была заполнена данными с листа 1 в течение 3 раз, например,

 Id 1 Date 21/OCT/2021 Name AAA Salary 1000  Id 2 Date 21/OCT/2021 Name BBB Salary 5000  Id 3 Date 21/OCT/2021 Name CCC Salary 6000  

Я использовал VLOOKUP и заполнил 1-ю запись и подумал о том, чтобы скопировать и вставить эти данные первой формы по нажатию кнопки в столько раз, сколько записей в листе1. Но я не уверен, как использовать VLOOKUP для следующей записи при копировании и вставке с использованием кода VBA.

Ниже приведен код, который я пробовал до сих пор:

 Dim destCell As Range Set destCell = Worksheets("sheet2").Cells(Rows.Count, "B").End(xlUp) If destCell.Row gt; 1 Then Set destCell = destCell.Offset(2) Worksheets("sheet2").Range("B6:Q20").Copy destCell.Worksheet.Select destCell.Select ActiveSheet.Paste Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteFormulas destCell.Select  Application.CutCopyMode = False  

Мне нужно просмотреть это для тех многих записей в листе1, а также при вставке мне нужно изменить идентификатор и формулу VLOOKUP.

Пожалуйста, протестируйте следующий код. Он вернется на следующем листе. Вы можете использовать любой лист, который вам нужен, но он должен быть установлен:

 Sub testSummarizeSalaries()  Dim sh As Worksheet, Destination As Worksheet, lastRow As Long, arr, arrFin, i As Long, k As Long    Set sh = ActiveSheet 'use here the sheet you need  Set Destination = sh.Next 'use here the sheet you need  lastRow = sh.Range("A" amp; sh.rows.count).End(xlUp).row 'if not the range starts with column A:A, use the appropriate column  arr = sh.Range("A2:C" amp; lastRow).Value 'place the range in an array for faster iteration  'if the range to be processed is not in columns A:C, use there the real columns  ReDim arrFin(1 To UBound(arr) * 4, 1 To 2): k = 1 'reDim the final array and initialize k  For i = 1 To UBound(arr)  arrFin(k, 1) = "ID": arrFin(k, 2) = arr(i, 1): k = k   1  arrFin(k, 1) = "Date": arrFin(k, 2) = format(Date, "dd/mmm/yyy"): k = k   1  arrFin(k, 1) = "Name": arrFin(k, 2) = arr(i, 2): k = k   1  arrFin(k, 1) = "Salary": arrFin(k, 2) = arr(i, 3): k = k   2 '2, to add an empty row after...  Next i  'drop the final array result, at once:  Destination.Range("A1").Resize(UBound(arrFin), UBound(arrFin, 2)).Value = arrFin  MsgBox "Ready..." End Sub  

Я бы получил доступ к ячейкам непосредственно в целевом листе, лучше, чем с помощью функции vlookup.

 Set wsSrc = Worksheets("sheet1") Set wsDest = Worksheets("sheet2") idxRowDest = 1 ' Not shown how to determine the number of source rows For idxRowSrc 2 to n  For idxColSrc = 1 to 3  ' Copy column header in Src to fieldName in Dest  wsDest.Cells(idxRowDest, 1).value = wsSrc.Cells(1, idxColSrc).value  ' Copy column value in Src to fieldValue in Dest  wsDest.Cells(idxRowDest, 2).value = wsSrc.Cells(idxRowSrc, idxColSrc).value  idxRowDest = idxRowDest   1   ' Other specific data  ' ...   Next Next  

Вероятно, это будет немного медленнее, чем использование операций с диапазоном, но это более простое решение, которое я нахожу для вашей проблемы.