宏以匹配工作表中的單元格，然后復制並粘貼相關單元格

Question

我正在嘗試制作一個宏，該宏將Sheet（“ Company”）的A列中的值與“ Current”的E列中的值匹配。 如果存在匹配項，並且該單元格右邊的單元格28（“當前”）為空，那么我想將其復制到“公司”中相應單元格右邊的單元格並將其粘貼。 它應該遍歷Sheet（“ Company”）的A列中的所有值。 為了增加難度，我很想實現一種ActiveSheet實用程序，以便可以將其應用於其他工作表，而不僅僅是“公司”。 這就是我所擁有的...

Option Explicit

Sub CopyPaster()

InvestorName As String

InvestorName = ActiveCell.Value

With Sheets("Current")

For i = 11 To 500:
    If i = InvestorName And Cells(i, 27) = 0 Then
        Sheets("Company").ActiveCell.Offset(0, 3).Copy          
        Sheets("Current").Cells(i, 28).PasteSpecial                
Next i

End Sub

第一個顯示當前工作表，第二個圖像是我要復制的公司工作表之一的示例。

Answer 1

根據給出的信息，我認為這是您所追求的。 請仔細檢查我是否選擇了正確的列，沒有數據就很難猜到您指的是什么。

Sub StackExchangeVlookup()

Dim Company As Worksheet
Dim Current As Worksheet

'set worksheets with the names of the sheets to compare
Set Company = Sheets("Company")
Set Current = Sheets("Current")

Dim myRange As range
Dim myCell As range
'Set the range to the column you want to replace empty cells in. I think I counted
'correctly, but maybe not. If AF is not correct, will also need to change the 32
Set myRange = range("AF1", Cells(Rows.count, 32).End(xlUp))

'if the cell is empty in the column AF (or whichever is the one you want, then use
'the VLOOKUP function.
For Each myCell In myRange
    If Len(myCell) = 0 Then
    'VLOOKUP will get the cell in column E of the row of the blank space in AF, compare
    'it to Column A in Company, and then return the value to the right of the cell found
    'in the Company sheet.
        myCell.Value = _
    "=VLOOKUP(" & Current.Name & "!E" & myCell.Row & "," & Company.Name & "!A:B, 2, FALSE)"
    End If
Next myCell

End Sub