在 VBA 中查找和替换代码答案

【问题标题】：Find and replace code in VBA在 VBA 中查找和替换代码
【发布时间】：2018-04-29 23:46:31
【问题描述】：

我也是 stackoverflow 和 VBA 的新手。我正在尝试编写一个代码，它从一个工作表选项卡读取文件的名称，转到另一个工作表选项卡，查找此文件名。如果代码从 Sheet1 中找到与 Sheet2 中完全相同的文件名，则会突出显示 Sheet2 中该单元格的颜色。我在这方面取得了部分成功。以下是问题：

在 Sheet1 中，文件名类似于 FILE 001、FILE 028、FILE 38、FILE 102 等。我手动更改了一些文件名，使其编号为三位（只是为了测试代码）。只要代码到达 FILE 38，它就会停止。那么问题1，我怎样才能首先将所有文件名更改为名称中包含3位数字？

其次，在 Sheet2 中，FILE 001 多次出现。我的代码仅突出显示它找到的第一个实例。如何解决这个问题？我正在复制下面的代码并感谢帮助。

Sub ColorImportantFiles()

Dim NumberOfCells As Integer
Dim LoopCounter As Integer
Dim FileName As String
Dim SearchFileRange As Range

Worksheets("Sheet1").Activate
NumberOfCells = Range("A3:A38").Count

For LoopCounter = 1 To NumberOfCells
    Worksheets("Sheet1").Activate
    FileName = Range("A2").Offset(LoopCounter, 1).Value

    Worksheets("Sheet2").Activate
    Set SearchFileRange = Range("B3", Range("B2").End(xlDown))

       If SearchFileRange.Find(what:=FileName, lookat:=xlWhole) = FileName Then
       SearchFileRange.Find(what:=FileName, lookat:=xlWhole).Interior.Color 
   = rgbBlueViolet

       Else: Exit Sub
       End If
   Next LoopCounter
End Sub

【问题讨论】：

您可以使用条件格式进行着色。不需要 VBA。
要添加零，您可以在工作表的其他地方使用如下公式，然后将结果复制为原始数字上的值：= "FILE " & TEXT(SUBSTITUTE(A3, "FILE ",""),"000"),
不要追溯更改文件名，而是在 in

标签： vba excel

【解决方案1】：

你可以试试这个：

Option Explicit

Sub ColorImportantFiles()

    Dim fileName As String, firstAddress As String
    Dim searchFileRange As Range, cell As Range, f As Range, cellsToColor As Range

    With Worksheets("Sheet2")
        Set searchFileRange = .Range("B3", .Range("B2").End(xlDown))
        Set cellsToColor = .Range("A1")
    End With

    For Each cell In Worksheets("Sheet1").Range("A3:A38").SpecialCells(xlCellTypeConstants)
        fileName = "FILE " & Format(Split(cell.Value, " ")(1), "000")
        With searchFileRange
            Set f = .Find(what:=fileName, LookIn:=xlValues, lookat:=xlWhole)
            If Not f Is Nothing Then
                firstAddress = f.Address
                Do
                    Set cellsToColor = Union(f, cellsToColor)
                    Set f = .FindNext(f)
                Loop While f.Address <> firstAddress
            End If
        End With
    Next
    If cellsToColor.Count > 1 Then Intersect(cellsToColor, cellsToColor.Parent.Columns(2)).Interior.Color = rgbBlueViolet

End Sub

【讨论】：