我对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
答案 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