Question

以下代码基本上会搜索任何工作表中的任何关键字并突出显示它。我的问题是，除了突出显示之外，如何将发现单词/单词的整个行号复制到新表中？

是否也可以精确地在哪个工作表中进行搜索？

非常感谢，贡萨洛

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

Answer 1

在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")

VBA代码，用于补充工作表上的搜索关键字，并将选定的副本行添加到新工作表中

1 个答案: