以下代码基本上会搜索任何工作表中的任何关键字并突出显示它。我的问题是,除了突出显示之外,如何将发现单词/单词的整个行号复制到新表中?
是否也可以精确地在哪个工作表中进行搜索?
非常感谢, 贡萨洛
Sub CheckMULTIVALUE()
'This macro searches the entire workbook for any cells containing the text "#MULTIVALUE" and if found _
highlight the cell(s) in yellow. Once the process has completed a message box will appear confirming completion.
Dim i As Long
Dim Fnd As String
Dim fCell As Range
Dim ws As Worksheet
Application.ScreenUpdating = False
Fnd = InputBox("Find what:", "Find and Highlight", "#MULTIVALUE")
If Fnd = "" Then Exit Sub
For Each ws In Worksheets
With ws
Set fCell = .Range("A1")
For i = 1 To WorksheetFunction.CountIf(.Cells, Fnd)
Set fCell = .Cells.Find(What:=Fnd, After:=fCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False)
If fCell Is Nothing Then
MsgBox Fnd & " not on sheet !!"
Exit For
Else
With fCell
.Interior.ColorIndex = 6
End With
End If
Next i
End With
Next ws
Application.ScreenUpdating = True
MsgBox "Check complete"
End Sub
答案 0 :(得分:0)
在For
循环之前添加代码以创建结果工作表,或者如果它已经存在则清除它:
Dim results As Worksheet: Set results = ActiveWorkbook.Sheets("Results")
If results Is Nothing Then
Set results = ActiveWorkbook.Sheets.Add()
results.Name = "Results"
Else
results.Cells.Clear
End If
创建对其A1
单元格和计数器的引用:
Dim resultsRange As Range: Set resultsRange = results.Range("A1")
Dim matches As Long
当您找到匹配项时,将所需内容添加到“结果”工作表中并递增计数器。
With fCell
.Interior.ColorIndex = 6
resultsRange.Offset(matches, 0).Value = fCell.Row
resultsRange.Offset(matches, 1).Value = fCell.Value
matches = matches + 1
End With
要指定特定工作表,请移除For Each ws In Worksheets
和Next ws
并将With ws
替换为With ActiveWorkbook.Sheets("SheetNameHere")