查找字符串并将其他值粘贴到其他列但同一行 vba excel

Question

我目前正在研究数据集的宏。宏需要在 A 列中找到字符串“page”的行，然后将 worksheet(3) 中的另一个值粘贴到 M 列并与“page”在同一行中。我已经有一些来自上一个问题Find, select, and copy row 的代码，但我不知道如何指定我要粘贴到列 M 和与字符串相同的行中。

这是我所拥有的：

With ThisWorkbook
        Set wsSource = .Worksheets("Overview")
        Set wsDestination = .Worksheets("Overview")
    End With
    
    'Set the value you want to search
    strSearch = "*Page*"
    
    'Set the column you want to seach
    ColumnNo = 1
    
    'Create a with statement to point Sheet1.
    With wsSource
        
        'Search for strSearch in column number ColumnNo
        Set rngFound = .Columns(ColumnNo).Find(strSearch, LookIn:=xlValues, lookat:=xlWhole)
        
        If Not rngFound Is Nothing Then
            LastRow = wsDestination.Cells(wsDestination.Rows.Count, "A").End(xlUp).Row + 1
            'Copy row.
            .Rows(rngFound.Row).EntireRow.Copy
            'Paste row
            wsDestination.Rows(LastRow).PasteSpecial Paste:=xlPasteValues
            'Delete row
            .Rows(rngFound.Row).EntireRow.Delete Shift:=xlUp
       
        End If
        
    End With

我现在需要调整上面指定的代码。有人可以帮我吗？ 提前致谢

Answer 1

如果您的数据只重复一次，则此代码可以。但如果您的文本“页面”重复多次，则您需要使用 Findnext 函数..这是一个代码，它将返回包含页面文本的单元格范围..那么您需要使用范围内的每个单元格并计算行号..

'Uses Range.Find to get a range of all find results within a worksheet
' Same as Find All from search dialog box
'Where search start from First cell and go to last cell.So that we say that search start after lastcell = .cells(.cells.count)
Function FindAll(rng As Range, What As Variant, Optional LookIn As XlFindLookIn = xlValues, Optional LookAt As XlLookAt = xlPart, Optional SearchOrder As XlSearchOrder = xlByRows, Optional SearchDirection As XlSearchDirection = xlNext, Optional MatchCase As Boolean = False, Optional MatchByte As Boolean = False, Optional SearchFormat As Boolean = False) As Range
'For containing matched range.
Dim SearchResult As Range
'For first matched address.
Dim firstMatch As String
With rng
    'Find first Matched result.
    Set SearchResult = .Find(What, .Cells(.Cells.count), LookIn, LookAt, SearchOrder, SearchDirection, MatchCase, MatchByte, SearchFormat)
    'If SearchResult <> Nothing then set the firstmatched range address to the variable.
    If Not SearchResult Is Nothing Then
        firstMatch = SearchResult.Address
        Do
            If FindAll Is Nothing Then
                'FindAll = nothing then set FindAll = first match cell
                Set FindAll = SearchResult
            Else
                'If FindAll contain some range then union previous range with new match result range.
                Set FindAll = Union(FindAll, SearchResult)
            End If
            'Change the SearchResult to next matched cell.
            'FindNext will start from previous SearchResult address.
            Set SearchResult = .FindNext(SearchResult)
        'Loop until the SearchResult contains no address or address <>first address.
        Loop While Not SearchResult Is Nothing And SearchResult.Address <> firstMatch
    End If
End With
End Function

您的发送范围将是 Column A..range("A:A")...如果您想要部分匹配或全部匹配，那么您需要传递该变量或将默认值设置为您方便的选项..并且如果您只想返回仅包含行号的数组，则添加变量作为函数的输出并相应地更改函数...如果您需要其他任何内容，请在此处评论。