识别最后使用的单元格并粘贴到下面

Question

我是 VBA 的新手。我有以下代码进行匹配练习，然后将相关值粘贴到 col. B. 我的问题是每次使用代码时，col 都会更改如何将其添加到模块中，以便它查找第 1 行中使用的最后一个单元格并粘贴以下值。

Sub TransferData()

Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
Dim myname As String

Application.ScreenUpdating = False

lastrow1 = Sheets("Input Sheet").Range("B" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow1
    myname = Sheets("Input Sheet").Cells(i, "B").Value
    Sheets("Data").Activate
    lastrow2 = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row

    For j = 2 To lastrow2
        If Sheets("Data").Cells(j, "A").Value = myname Then
            Sheets("Input Sheet").Activate
            Sheets("Input Sheet").Cells(i, "c").Copy
            Sheets("Data").Activate
            Sheets("Data").Cells(j, "B").Select
            ActiveSheet.PasteSpecial
        End If
    Next j
    Application.CutCopyMode = False
Next i
Application.ScreenUpdating = True

End Sub

我们将不胜感激。

Answer 1

您可以将第二个 For j = 2 To lastrow2 替换为 Match 函数。

另外，没有必要一直在后面和第四张Activate，只需使用完全限定的Ranges。

代码

Option Explicit

Sub TransferData()

Dim i As Long, j As Long, lastrow1 As Long, lastrow2 As Long
Dim myname As String
Dim MatchRng    As Range

Application.ScreenUpdating = False
j = 2
With Sheets("Input Sheet")
    lastrow1 = .Range("B" & .Rows.Count).End(xlUp).Row

    ' the 2 lines bellow should be outisde the loop
    lastrow2 = Sheets("Data").Range("A" & Sheets("Data").Rows.Count).End(xlUp).Row
    Set MatchRng = Sheets("Data").Range("A2:A" & lastrow2)
    For i = 2 To lastrow1
        myname = .Range("B" & i).Value

        If Not IsError(Application.Match(myname, MatchRng, 0)) Then '<-- if successful Match
            Sheets("Data").Range("B" & j).Value = .Range("C" & i).Value
            j = j + 1
        End If
        Application.CutCopyMode = False
    Next i
End With
Application.ScreenUpdating = True

End Sub