VBA查找和替换,但为整个列着色

时间:2015-06-30 19:47:33

标签: excel vba excel-vba

我对VBA相当新(因为这是我第一次尝试使用它)并且正在开发一个宏来查找和替换一组数字,这些数字在名为“AA SERIES”的电子表格中略有修改。我将这些存储在一个名为“PartNumbers”的电子表格中,第一列中的现有表格和J中的替换表。下面显示的代码适用于此:

Sub Macro1()  
Dim i As Integer  
Dim WS As Worksheet  
Dim FindStr As String  
Dim RepStr As String  
For i = 1 To 87

   For Each WS In Workbooks("AA SERIES").Worksheets  
    FindStr = Workbooks("PartNumbers").Sheets("Sheet1").Range("I" & i).Value  
    RepStr = Workbooks("PartNumbers").Sheets("Sheet1").Range("J" & i).Value  
    Cells.Replace What:=FindStr, Replacement:=RepStr

   Next  
Next i

End Sub

然而,如果宏替换了一个值,我想要它做的还是将整个列格式化为不同的颜色(理想情况下是浅紫色)。目标是使用此工作表的下一个人将能够快速滚动并查看更改的位置。

有什么建议吗?

2 个答案:

答案 0 :(得分:0)

我认为这就是你要找的东西:
https://msdn.microsoft.com/en-us/library/bb209118%28v=office.12%29.aspx

目前无法验证它......但我认为它的工作原理如下:

Application.ReplaceFormat.Interior.Color = RGB(200, 150, 200)

Cells.Replace What:=FindStr, Replacement:=RepStr, SearchFormat:=False, ReplaceFormat:=True

修改
要为整个列着色,您必须搜索光谱细胞并为每个找到的单元格的整个列应用颜色更改

Application.FindFormat.Interior.Color = RGB(200, 150, 200)
Cells.Find(SearchFormat:=True).EntireColumn.Interior.Color = RGB(200, 151, 200)
'slightly changed colorcode to avoid endless loop, if you want to loop through all changed cells

答案 1 :(得分:0)

扩展上一个答案:

Option Explicit

Sub replace1()

    Const ENTIRE_COLUMN As Byte = 0     'Change to 1 to color the entire columns

    Dim i       As Integer
    Dim ws      As Worksheet
    Dim findStr As String
    Dim repStr  As String
    Dim lPurple As Long
    Dim found   As Range
    Dim first   As String

    lPurple = RGB(244, 233, 255)

    Application.ReplaceFormat.Interior.Color = lPurple

    For Each ws In Workbooks("AA SERIES").Worksheets
        For i = 1 To 9
            With Workbooks("PartNumbers").Sheets("Sheet1")
                findStr = .Range("I" & i).Value
                repStr = .Range("J" & i).Value

                ws.UsedRange.Replace What:=findStr, _
                                     Replacement:=repStr, _
                                     ReplaceFormat:=True

                If ENTIRE_COLUMN = 1 Then
                    With ws.UsedRange
                        Set found = .Find(What:=repStr, SearchOrder:=xlByRows)
                        If Not found Is Nothing Then
                            first = found.Address
                            Do
                                If found.Offset(1).Interior.Color <> lPurple Then
                                    .Columns(found.Column).Interior.Color = lPurple
                                End If
                                Set found = .FindNext(found)
                            Loop While Not found Is Nothing And found.Address <> first
                        End If
                    End With
                End If

            End With
        Next
    Next
End Sub