Question

我在Excel中有一列（D）数据已经使用以下方式排序：的 = TEXT（B2， “###”）即可。这是为了显示一个包含额外“REP 1”的数据列表（数字）。

并非所有数据都包含“REP 1”，因此我想强调所有包含 BOTH 数字和“REP 1”的字段。我可以突出显示所有“REP 1”字段，并查看之前是否有重复，但这只是一个示例表。我有超过8,000多个字段需要通过，而且耗时太长。

请参阅以下链接以获取示例：

我希望这一切都有道理。谢谢，

添

Answer 1

不确定是否可以使用条件格式，但此VBA代码应该可行。您的数据不必按任何特定顺序排序，并假设您正在格式化的数据位于D列。我已经测试了几百行并且工作正常，所以应该没问题。大数据集。我试图通过代码中的注释来解释代码的作用。

            Sub formatCells()


            Dim x As Variant
            Dim y As Variant
            Dim searchval As String
            Dim a As Variant
            Dim lastrow As Long
            Dim rng As Range

            Application.ScreenUpdating = False ' turn off screen updates

            lastrow = Cells(Rows.Count, 4).End(xlUp).Row 'find the last blank cell
            x = 2 'set rownumber
            y = 4 'set columnnumber


            While Cells(x, y) <> "" ' create loop
                If InStr(Cells(x, y), "REP1") Then 'search for string in cell
                    Cells(x, y).Interior.Color = RGB(255, 0, 0) 'if string exists fill cell

                End If

            x = x + 1 ' loop

            Wend ' end loop

            x = 2 ' reset row number
            y = 4 ' reset column number

            While Cells(x, y) <> "" ' create loop 2
                If Cells(x, y).Interior.Color = RGB(255, 0, 0) And InStr(Cells(x, y), "REP1") Then 'if cells is red and contains Rep1

                    a = Cells(x, y).Value ' set a to equal the cell that is red and and contains REP1
                        searchval = Left(a, Len(a) - 5) 'remove space and REP1 and set value ready for search

                    If searchval <> "" Then 'if theres a search value available run steps below

                        With Range("D1:D" & lastrow) 'set range to be column A
                            Set rng = .Find(What:=searchval, _
                                        After:=.Cells(1), _
                                        LookIn:=xlValues, _
                                        LookAt:=xlWhole, _
                                        SearchOrder:=xlByRows, _
                                        SearchDirection:=xlPrevious, _
                                        MatchCase:=False)
                            If Not rng Is Nothing Then 'If search value is found
                                Application.Goto rng, True ' go to cell
                                ActiveCell.Interior.Color = RGB(255, 0, 0) 'set cell to red
                             End If
                        End With

                    End If
                End If

             x = x + 1 'loop 2

            Wend ' end loop 2

            End Sub

编辑 - 查看B栏而不是D

            Sub formatCells()


        Dim x As Variant
        Dim y As Variant
        Dim searchval As String
        Dim a As Variant
        Dim lastrow As Long
        Dim rng As Range

        Application.ScreenUpdating = False ' turn off screen updates

        lastrow = Cells(Rows.Count, 2).End(xlUp).Row 'find the last blank cell
        x = 2 'set rownumber
        y = 2 'set columnnumber


        While Cells(x, y) <> "" ' create loop
            If InStr(Cells(x, y), "REP1") Then 'search for string in cell
                Cells(x, y).Interior.Color = RGB(255, 0, 0) 'if string exists fill cell

            End If

        x = x + 1 ' loop

        Wend ' end loop

        x = 2 ' reset row number
        y = 2 ' reset column number

        While Cells(x, y) <> "" ' create loop 2
            If Cells(x, y).Interior.Color = RGB(255, 0, 0) And InStr(Cells(x, y), "REP1") Then 'if cells is red and contains Rep1

                a = Cells(x, y).Value ' set a to equal the cell that is red and and contains REP1
                    searchval = Left(a, Len(a) - 5) 'remove space and REP1 and set value ready for search

                If searchval <> "" Then 'if theres a search value available run steps below

                    With Range("B1:B" & lastrow) 'set range to be column A
                        Set rng = .Find(What:=searchval, _
                                    After:=.Cells(1), _
                                    LookIn:=xlValues, _
                                    LookAt:=xlWhole, _
                                    SearchOrder:=xlByRows, _
                                    SearchDirection:=xlPrevious, _
                                    MatchCase:=False)
                        If Not rng Is Nothing Then 'If search value is found
                            Application.Goto rng, True ' go to cell
                            ActiveCell.Interior.Color = RGB(255, 0, 0) 'set cell to red
                         End If
                    End With

                End If
            End If

         x = x + 1 'loop 2

        Wend ' end loop 2

        End Sub

EXCEL：突出显示同一列中的重新复制数据

1 个答案: