当匹配字符串时,如何找到字符串关键字并将其粘贴到其下面的行?

时间:2016-09-06 23:29:37

标签: excel vba excel-vba macros

我对VBA很新。我正在尝试编写一个宏来搜索单词" date"在所有标题名称(第1行中的所有变量名称)中,将一个单元格(从另一个工作表)复制到找到匹配项的标题下的行中(第2行)。

粘贴部分目前不起作用,我正在搜索整个工作簿,因为我不知道如何将其设置为仅搜索标题行。

Sub FindAndPaste()

Dim Sheet As Worksheet
Dim Loc As Range

For Each Sheet In ThisWorkbook.Worksheets
    With Sheet.UsedRange
    Set Loc = .Cells.Find(What:="date")
    If Not Loc Is Nothing Then
        Do Until Loc Is Nothing
            Sheets("Sheet1").Range("L3").Copy
            Loc.Value.Offset(1, 0).PasteSpecial xlPasteAll
            Set Loc = .FindNext(Loc)
        Loop
    End If
End With
Set Loc = Nothing
Next
End Sub

我还尝试通过将其更改为下面的代码来更改Do Until循环中的部分,但这似乎也不起作用。

Do Until Loc Is Nothing
    copiedval = Sheets("Sheet1").Range("L3").Copy
    Loc.Value.Offset(1, 0).Value = copiedval
    Set Loc = .FindNext(Loc)
Loop

2 个答案:

答案 0 :(得分:2)

如果不使用Find()

,这将更加直截了当

目前尚不清楚您是在寻找包含日期的单元格,还是只查找值为“date”的单元格。

或者您是否要从搜索中排除Sheet1

Sub FindAndPaste()

    Dim Sheet, wb As workbook
    Dim c As Range, arrSheets

    Set wb = ThisWorkbook

    arrSheets = Array(wb.sheets("Sheet2"), wb.sheets("Sheet3"))

    For Each Sheet In arrSheets
        For Each c in Sheet.UsedRange.Rows(1).Cells
            If c.value like "*date*" Then
                wb.Sheets("Sheet1").Range("L3").Copy c.Offset(1,0)
                c.Offset(1,0).NumberFormat = "yyyy/mm/dd" '<<<<<<<<<EDIT 
            End If
        Next c
    Next
End Sub

答案 1 :(得分:1)

试试这个

Sub FindAndPaste()

Dim sht As Worksheet
Dim Loc As Range, founds As Range
Dim firstAddress As String

For Each sht In ThisWorkbook.Worksheets
    Set founds = sht.Cells(2,1)
    With Intersect(sht.Rows(1), sht.UsedRange)
        Set Loc = .Find(What:="date", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
        If Not Loc Is Nothing Then
            firstAddress = Loc.Address
            Do
                Set founds = Union(founds, Loc)
                Set Loc = .FindNext(Loc)
            Loop While Not Loc.Address <>firstAddress
            Intersect(.Cells,founds).Offset(1).Value =Sheets("Sheet1").Range("L3").Value
        End If
    End With
Next sht

End Sub

如果您需要查找包含“日期”的标题,而不是仅使用LookAt:=xlWhole替换LookAt:=xlPart