Найдите значение в диапазоне и отформатируйте диапазон рядом с ним - PullRequest
Новая
       30

Найдите значение в диапазоне и отформатируйте диапазон рядом с ним

0 голосов
/ 01 марта 2019

У меня есть значение «TO:» в каждой второй или третьей строке, но разные столбцы.Я пытался найти «TO:» в листе и заполнить ячейки красным цветом до столбца А, назад.Я нашел макрос и настроил его следующим образом.Мне удалось закрасить «TO:» красным, но не удалось заполнить цветом ячейки до столбца A. Например, если TO находится в L2, залейте красным L2: A2 и аналогичным образом.Любая помощь будет оценена. 

Sub FindAndChangeStyle()

Dim TestPhrases() As String
Dim rng, Rng2 As Range
Dim lastCol, i As Long
TestPhrases = Split("TO:", "KotaPota")
 Set rng = ActiveSheet.Range(ActiveSheet.UsedRange.Address)


With ActiveSheet
Dim oLookin As Range
   Dim CheckCell As Range
    For Each CheckCell In rng


        Dim Looper As Long
        For Looper = LBound(TestPhrases) To UBound(TestPhrases)

            If InStr(CheckCell.Value, TestPhrases(Looper)) Then
                CheckCell.Font.Bold = True
                CheckCell.Interior.Color = vbRed

                Exit For
            End If


        Next Looper

    Next CheckCell
End With

   End Sub

1 Ответ

0 голосов
/ 02 марта 2019

Если я что-то упустил, возможно, вы можете просто пройтись по всем ячейкам, содержащим подстроку "TO:" (используя Range.Find).

Приведенный ниже код будет пытаться найти все регистрозависимые, частичныесоответствует подстроке "TO:" и заставляет применить некоторое форматирование к ячейкам в этой строке (начиная со столбца A и заканчивая ячейкой, содержащей подстроку). 

Option Explicit

Private Sub ColourMatchingCells()
    With ThisWorkbook.Worksheets("Sheet1")

        Dim matchFound As Range
        Set matchFound = .Cells.Find("TO:", , xlValues, xlPart, xlByRows, xlNext, False) ' This will search all cells (of the sheet). Change as needed. '

        If matchFound Is Nothing Then
            MsgBox ("Could not find a single cell containing the substring. Code will stop running now.")
            Exit Sub
        End If

        Dim addressOfFirstMatch As String
        addressOfFirstMatch = matchFound.Address

        Do
            With .Range(.Cells(matchFound.Row, "A"), matchFound)
                .Font.Bold = True
                .Interior.Color = vbRed
            End With
            Set matchFound = .Cells.FindNext(matchFound)
        Loop Until matchFound.Address = addressOfFirstMatch ' Once you have looped through all matches, you should return to the first one '
    End With
End Sub
...