VBA Excel根据找到的值将值粘贴到新单元格中

Question

我无法将值粘贴到新单元格中，从＆＃34; D5＆＃34;开始，直到找不到找到的值。我可以找到值并删除找到值的行的单元格，但我需要粘贴。我希望能够获取B列并查找$ TC_TP2 [2] =＆＃34; 9070036＆＃34;的所有匹配项。并且仅在位置粘贴9070036＆＃34; D5＆＃34;然后找$ TC_TP2 [3] =＆＃34; 9005270＆＃34;并粘贴9005270＆＃34; D6＆＃34;等等查找$ TC_TP2的每个实例并在等号后粘贴该值。我将粘贴我在下面开始的代码并且它有点长，因为我不知道如何在1个循环中进行多次搜索，所以我做了四个循环。

Sub Find_Example()

    Dim calcmode As Long
    Dim ViewMode As Long
    Dim TP2String As Variant
    Dim DP3String As Variant
    Dim MOP1String As Variant
    Dim MOP2String As Variant
    Dim FoundCell As Range
    Dim I As Long
    Dim myRng As Range
    Dim sh As Worksheet

    With Application
        calcmode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    'We use the ActiveSheet but you can also use Sheets("MySheet")
    Set sh = ActiveSheet

    'We search in column B in this example
    Set myRng = sh.Range("B:B")

    'Add more search strings if you need
    TP2String = Array("*TC_TP2*")
    DP3String = Array("*TC_DP3*")
    MOP1String = Array("*TC_MOP1*")
    MOP2String = Array("*TC_MOP2*")


    With sh

        'We select the sheet so we can change the window view
        .Select

        'If you are in Page Break Preview Or Page Layout view go
        'back to normal view, we do this for speed
        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView

        'Turn off Page Breaks, we do this for speed
        .DisplayPageBreaks = False

        'We will search the values in MyRng in this example
        With myRng

            For I = LBound(TP2String) To UBound(TP2String)
                Do
                    Set FoundCell = myRng.Find(What:=TP2String(I), _
                                               After:=.Cells(.Cells.Count), _
                                               LookIn:=xlFormulas, _
                                               LookAt:=xlWhole, _
                                               SearchOrder:=xlByRows, _
                                               SearchDirection:=xlNext, _
                                               MatchCase:=False)
                    If FoundCell Is Nothing Then
                        Exit Do
                    Else
                        **Range("D10").Select
                        FoundCell.Paste**        <---- Where I tried to paste
                    End If
                Loop
            Next I

        End With

    End With

    With sh
        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView

        'Turn off Page Breaks, we do this for speed
        .DisplayPageBreaks = False

        'We will search the values in MyRng in this example


With myRng

            For I = LBound(DP3String) To UBound(DP3String)
                Do
                    Set FoundCell = myRng.Find(What:=DP3String(I), _
                                               After:=.Cells(.Cells.Count), _
                                               LookIn:=xlFormulas, _
                                               LookAt:=xlWhole, _
                                               SearchOrder:=xlByRows, _
                                               SearchDirection:=xlNext, _
                                               MatchCase:=False)
                    If FoundCell Is Nothing Then
                        Exit Do
                    Else
                        FoundCell.EntireRow.Delete
                    End If
                Loop
            Next I

        End With

    End With

    With sh
        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView

        'Turn off Page Breaks, we do this for speed
        .DisplayPageBreaks = False

        'We will search the values in MyRng in this example
        With myRng

            For I = LBound(MOP1String) To UBound(MOP1String)
                Do
                    Set FoundCell = myRng.Find(What:=MOP1String(I), _
                                               After:=.Cells(.Cells.Count), _
                                               LookIn:=xlFormulas, _
                                               LookAt:=xlWhole, _
                                               SearchOrder:=xlByRows, _
                                               SearchDirection:=xlNext, _
                                               MatchCase:=False)
                    If FoundCell Is Nothing Then
                        Exit Do
                    Else
                        FoundCell.EntireRow.Delete
                    End If
                Loop
            Next I

        End With

    End With

    With sh
        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView

        'Turn off Page Breaks, we do this for speed
        .DisplayPageBreaks = False

        'We will search the values in MyRng in this example
With myRng

            For I = LBound(MOP2String) To UBound(MOP2String)
                Do
                    Set FoundCell = myRng.Find(What:=MOP2String(I), _
                                               After:=.Cells(.Cells.Count), _
                                               LookIn:=xlFormulas, _
                                               LookAt:=xlWhole, _
                                               SearchOrder:=xlByRows, _
                                               SearchDirection:=xlNext, _
                                               MatchCase:=False)
                    If FoundCell Is Nothing Then
                        Exit Do
                    Else
                        FoundCell.EntireRow.Delete
                    End If
                Loop
            Next I

        End With

    End With



    ActiveWindow.View = ViewMode
    With Application
        .ScreenUpdating = True
        .Calculation = calcmode
    End With

End Sub