更改 VLookup 時將數據從一張紙復制到另一張紙

Question

嗨，我是 excel 宏的新手，我正在嘗試將數據從一張紙復制到另一張紙。 在第一張紙中，我有如下數據

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

在另一個 sheet2 中，我有一個按鈕，單擊它我需要為 sheet1 中的所有記錄生成以下格式（某種形式）的數據。

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

在我的情況下，單擊按鈕時，我需要在上面的表單中填寫來自 sheet1 的數據 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 並填寫了第一條記錄，並考慮在單擊按鈕時將第一個表單數據復制並粘貼到與 sheet1 中的記錄數一樣多的次數。 但是我不確定在使用 VBA 代碼復制和粘貼時如何使用 VLOOKUP 進行下一條記錄。

下面是我試過的代碼，

Dim destCell As Range
Set destCell = Worksheets("sheet2").Cells(Rows.Count, "B").End(xlUp)
If destCell.Row > 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

我需要為 sheet1 中的許多記錄遍歷這個，並且在粘貼時我必須更改 Id 和 VLOOKUP 公式。

Answer 1

請測試下一個代碼。 它將在下一個工作表中返回。 您可以使用任何需要的工作表，但必須設置：

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" & sh.rows.count).End(xlUp).row 'if not the range starts with column A:A, use the appropriate column
  arr = sh.Range("A2:C" & 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

Answer 2

我會直接訪問目標工作表中的單元格，而不是使用 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

可能這會比使用范圍操作慢一點，但這是我為您的問題找到的更簡單的解決方案。