Окрашивание строки, где макрос находит определенное слово

Question

Я хотел бы знать, есть ли способ использовать следующую вещь с помощью VBA: Если макрос находит слово «Всего» в столбце B, тогда inner.color of строка, в которой сумма будет окрашена в синий цвет, и делать это для всех «тотальных» слов в столбце B. Примечание: у меня разные итоги ... это не только слово «Всего»

НРАВИТСЯ ЭТО (т.е. окраска от Col A до F)

Я пытался с этим, но это не работает должным образом и код плохо ...

Sub forme_couleur() 
Dim myRow As Integer 

    myRow = 1 

    While Not IsEmpty(Cells(myRow, 2)) 
    If Cells(myRow, 2).Find(What:="Total") Is Nothing Then 
     myRow = myRow + 1 
    Else 
     Cells(myRow, 2).Find(What:="Total").Interior.Color = RGB(174, 240, 194) 
    End If 
    myRow = myRow + 1 
    Wend 
End Sub 

Answer 1

Рассмотрим:

Sub ColorMeBlue() 
    Dim i As Long, N As Long, s As String 
    N = Cells(Rows.Count, "B").End(xlUp).Row 
    s = "Total" 

    For i = 1 To N 
     If InStr(1, Cells(i, 2).Value, s) > 0 Then 
      Range("A" & i & ":F" & i).Interior.Color = RGB(174, 240, 194) 
     End If 
    Next i 
End Sub 

EDIT # 1:

Для обозначения диапазона, используя столбцы числа, используйте:

Sub ColorMeBlue2() 
    Dim i As Long, N As Long, s As String 
    N = Cells(Rows.Count, "B").End(xlUp).Row 
    s = "Total" 
    Firstcol = 1 
    LastCol = 6 
    For i = 1 To N 
     If InStr(1, Cells(i, 2).Value, s) > 0 Then 
      Range(Cells(i, Firstcol), Cells(i, LastCol)).Interior.Color = RGB(174, 240, 194) 
     End If 
    Next i 
End Sub 

Answer 2

Вы можете сделать с помощью формулы на основе условного форматирования, используя COUNTIF (a1: f1, "Total") функция благосостояния> 0

Answer 3

Вы можете достичь этого с помощью условного форматирования, но если вы должны сделать это с помощью VBA использовать что-то вроде следующего:

Sub test() 

For i = 1 To Cells(ActiveSheet.Rows.Count, "B").End(xlUp).Row 
If InStr(1, Cells(i, 2), "Total") Then 
    With Cells(i, 2).EntireRow.Interior 
     .Pattern = xlSolid 
     .PatternColorIndex = xlAutomatic 
     .ThemeColor = xlThemeColorLight2 
     .TintAndShade = 0.399975585192419 
     .PatternTintAndShade = 0 
    End With 
End If 
Next i 
End Sub 

Answer 4

Другая концепция: Вы можете пойти с методом AutoFilter. Использование этого метода не требует каких-либо цепей For или любых If s, просто используйте все ячейки, которые передают AutoFilter критерии ="*Total*" внутри вашего диапазона.

Sub ColorMeBlue_Filter() 

Dim i As Long, N As Long, s As String 
Dim FirstCol As Long, LastCol As Long 
Dim FiltRng As Range 

N = Cells(Rows.Count, "B").End(xlUp).Row 
s = "Total" 

' (just for my testing) 
'FirstCol = 1 
'LastCol = 6 

Range("A1").AutoFilter 
Range(Cells(1, FirstCol), Cells(N, LastCol)).AutoFilter Field:=2, Criteria1:="=*Total*", _ 
     Operator:=xlAnd 

' set FiltRng to only visible cells (that passed the "Total" filter) 
Set FiltRng = Range(Cells(2, FirstCol), Cells(N, LastCol)).SpecialCells(xlCellTypeVisible) 

' modify interior color of all cells at once (one code line) 
FiltRng.Interior.Color = RGB(174, 240, 194) 

End Sub 

Answer 5

Range.Find Использования избегает: пробегает по каждой строке и необходимости получить последнюю строку.

Вместо применения Range.Find к каждой строке, просто применить его на всю колонку, не нужно, чтобы проверить, если ячейка пуста (см Range.Find Method (Excel) для получения дополнительной информации)

Voici Votre код Пересмотреть:

Предполагая, что ваши данные находятся в `A: F»

Sub forme_couleur() 
Const kCriteria As String = "Total" 
Dim rTrg As Range, s1stFound As String 
    With ThisWorkbook.Sheets("DATA").Columns(2)  'change as required 
     Set rTrg = .Cells.Find(What:=kCriteria, After:=.Cells(1), LookIn:=xlFormulas, _ 
      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext) 
     If Not (rTrg Is Nothing) Then 
      s1stFound = rTrg.Address 
      Do 
       rTrg.EntireRow.Cells(1).Resize(1, 6).Interior.Color = RGB(224, 240, 248) 'RGB(174, 240, 194) give me a green color - changed as required 
       Set rTrg = .Cells.FindNext(After:=rTrg) 
      Loop Until rTrg.Address = s1stFound 
    End If: End With 
    End Sub