Excel / VB - Как мне пройти по каждой строке / столбцу и выполнить форматирование на основе значения?

Question

Вот что мне нужно сделать:

1) Цикл каждой ячейки на листе 2) Внесите изменения форматирования (полужирный и т. Д.) В поля, относящиеся к каждому полю, на основе значения

Я имею в виду, что если поле имеет значение «foo», я хочу сделать поле, которое (-1, -3), выделено жирным шрифтом и т. Д. не повезло.

Спасибо Johnny

Псевдокод для объяснения:

For Each Cell in WorkSheet
    If Value of Cell is 'Subtotal'
        Make the cell 2 cells to the left and 1 cell up from here bold and underlined
    End If
End ForEach

Неудачный макрос (я вообще не знаю VB):

Sub Macro2()
'
'
'
Dim rnArea As Range
Dim rnCell As Range

Set rnArea = Range("J1:J2000")

    For Each rnCell In rnArea
        With rnCell
            If Not IsError(rnCell.Value) Then
                Select Case .Value
                    Case "000 Total"
                        ActiveCell.Offset(-1, -3).Select
                        ActiveCell.Font.Underline = XlUnderlineStyle.xlUnderlineStyleSingleAccounting
                End Select
            End If
        End With
    Next
End Sub

Answer 1

Исходя из комментариев к решению выше, я думаю, что это может быть полезно

Sub FormatSpecialCells()
    Dim SearchRange As Range
    Dim CriteriaRange As Range

    Set SearchRange = Range("A2:A24")
    Set CriteriaRange = Range("C2:C5")

    Dim Cell As Range

    For Each Cell In SearchRange
     TryMatchValue Cell, CriteriaRange
    Next


End Sub

Private Sub TryMatchValue(CellToTest As Range, CellsToSearch As Range)
    Dim Cell As Range

    For Each Cell In CellsToSearch
        If Cell.Value = CellToTest.Value Then
            Cell.Copy
            CellToTest.PasteSpecial xlPasteFormats, xlPasteSpecialOperationNone, False, False
        End If
    Next
End Sub

Это не полностью достигает вашей цели. Он выполняет поиск по указанному списку ячеек и сопоставляет их с отдельным списком ячеек. Если он соответствует значениям, он берет ФОРМАТ второго списка ячеек и применяет его к ячейке, которой он соответствует в первом списке ячеек. Вы можете изменить это, изменив функцию TryMatchValue, чтобы вместо сопоставления с CellToTest он вставлял формат в другую ячейку, размер которой 2 и один вверх.

Это имеет то преимущество, что, если вы хотите добавить больше значений и различные форматы, вам нужно всего лишь перейти на свой лист Excel и добавить больше значений. Также вам нужно только изменить формат на это значение.

Примером может быть ...

У вас есть ячейки, которые вы ищете в A1: D1000 Имеют эти значения в ячейках E2: E6 ... Итого (жирный и подчеркнутый) Всего (жирный, подчеркнутый и курсив) Чистая (которая подчеркнута жирным шрифтом и выделена красным) и т.д ...

затем, когда он попадет в промежуточный итог, он изменит ячейку на жирный и подчеркнутый. Когда он достигает значения Total, он изменит ячейку на жирный, подчеркнутый и курсив и т.д и т.д ...

надеюсь, это поможет

Answer 2

Может ли функциональность условного форматирования в Excel дать вам то, что вам нужно, без необходимости писать макрос?

Answer 3

Option Explicit

Private Sub macro2()
    Dim rnArea As Range
    Dim rnCell As Range

    ' you might need to change the range to the cells/column you want to format e. g. "G1:G2000" '
    Set rnArea = Range("J1:J2000")

    For Each rnCell In rnArea
        With rnCell
            If isBold(.Offset(1, 3).Value) Then
                .Font.Bold = True
            End If
            If isUnderlined(.Offset(1, 3).Value) Then
                'maybe you want this: .Font.Underline = xlUnderlineStyleSingle '
                .Font.Underline = xlUnderlineStyleSingleAccounting
            End If
        End With
    Next
End Sub

Private Function isBold(cellValue As Variant) As Boolean
    Dim myList() As Variant
    Dim listCount As Integer
    Dim i As Integer

    myList = Array("Totals", "FooTotal", "SpamTotal")
    listCount = 3

    isBold = False
    For i = 0 To listCount - 1
        If cellValue = myList(i) Then
            isBold = True
            Exit Function
        End If
    Next i
End Function

Private Function isUnderlined(cellValue As Variant) As Boolean
    Dim myList() As Variant
    Dim listCount As Integer
    Dim i As Integer

    myList = Array("FooTotal", "SpamTotal")
    listCount = 2

    isUnderlined = False
    For i = 0 To listCount - 1
        If cellValue = myList(i) Then
            isUnderlined = True
            Exit Function
        End If
    Next i
End Function

Я добавил две функции, но это также должно было работать с расширенным if / else if / else.