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张纸和第四张，只需使用完全合格的Range。

<强>代码

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

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

1 个答案: