Примите во внимание следующую таблицу Excel:

Я хотел бы отформатировать ячейки в строке 1:2 в соответствии со значениями в ячейках A4:B7. Если я изменю значения, ячейки в строке 1:2 должны быть объединены, окаймлены, заполнены и текст соответствующим образом окрашен.

Если я изменю форматирование ячеек на следующее:

1 ответ1

0

Вот решение VBA. Он копирует фон и цвета шрифта из таблицы Format поэтому, если вы хотите белый текст, используйте белый текст в этой таблице. Возможно, вы захотите изменить настройки границ (строки 39 и 47), а также место, где он ищет условия формата для использования (строки 27-30). Это особенно верно, если ваш пример - чистый макет, мало связанный с вашими реальными данными.

Option Explicit
Sub MadeFormattedHeadings()

    'Declarations
    Dim ws As Worksheet
    Dim headerRange As Range
    Dim rangeSize As Integer
    Dim rangeStart As Integer
    Dim r As Long
    Dim c As Integer

    'Choose the worksheet to use
    '(Pick one of these two methods)
    Set ws = Worksheets("Sheet1")   'This uses the name on the tab seen in Excel
    Set ws = Sheet1                 'This uses the code name seen in VBA

    With ws

        'Remove previous headers
        If UCase(.Range("A1").Value) = UCase(.Range("A5").Value) Then
            .Rows("1:2").Delete
            .Rows("1:2").Insert
        End If

        'Add new headers
        rangeStart = 1
        For r = 5 To 8  '<<<< There are other methods to iterate. This is just one option.
            'Save the settings
            Set headerRange = .Range("A" & r)
            rangeSize = .Range("B" & r).Value

            'Format the first row
            With .Range(.Cells(1, rangeStart), .Cells(1, rangeStart + rangeSize - 1))
                .Merge
                .Value = headerRange.Value
                .HorizontalAlignment = xlCenter
                .Font.Color = headerRange.Font.Color
                .Interior.Color = headerRange.Interior.Color
                .BorderAround xlSolid, xlThin
            End With

            'Format the second row
            With .Range(.Cells(2, rangeStart), .Cells(2, rangeStart + rangeSize - 1))
                .Merge
                .Value = rangeSize
                .HorizontalAlignment = xlCenter
                .BorderAround xlSolid, xlThin
            End With

            'Iterate to the next section
            rangeStart = rangeStart + rangeSize
        Next

    End With

End Sub

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .