Question

我也是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

Answer 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

在VBA中查找和替换代码

1 个答案: