Код для автоматической маркировки заголовков

Question

Как я могу получить заголовки «underproject», чтобы они были темнее отмечены автоматически? Я могу сделать это сам, но хочу, чтобы это произошло автоматически для всех заголовков.

Before & After

Range("A6:L6,A7:D7").Select 
With Selection.Interior 
    .Pattern = xlSolid 
    .PatternColorIndex = xlAutomatic 
    .ThemeColor = xlThemeColorLight1 
    .TintAndShade = 0.249977111117893 
    .PatternTintAndShade = 0 
End With 
With Selection.Font 
    .ThemeColor = xlThemeColorDark1 
    .TintAndShade = 0 
End With 
With Selection 
    .HorizontalAlignment = xlGeneral 
    .VerticalAlignment = xlBottom 
    .WrapText = False 
    .Orientation = 0 
    .AddIndent = False 
    .IndentLevel = 0 
    .ShrinkToFit = False 
    .ReadingOrder = xlContext 
    .MergeCells = True 
End With 

Answer 1

Вы можете сделать это с помощью условного форматирования. Выберите столбец таблицы A в столбце G и добавьте новое правило условного форматирования и выберите нижний параметр для ввода формулы. enter = left ($ A1,4) = «Unde» нажмите кнопку формата и выберите нужный формат.

Выберите столбцы от A до C и создайте другое условное правило форматирования и выберите формулу. Enter = left ($ A1,4) = "Navn" и установите желаемый формат.

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

Возможно использование макроса, но вам нужно будет пропустить все ячейки в столбце A, ищущие «Navn» и «Underproject», и использовать инструкции if для установки форматов.

код для удаления строк на основе товарной позиции

Я не могу сказать от вашего комментария, что это именно то, что вы хотите удалить, но и может изменить critera в соответствии с вашими требованиями.

ВАЖНО: перед выполнением этого макроса убедитесь, что вы сделали резервную копию своих данных, поскольку изменения, сделанные макросом, не могут быть отменены.

Sub DeleteEx() 

Dim intRow As Integer 
Dim strContinue As String 
Dim bolDelete As Boolean 'true or false 

intRow = 2 
strContinue = Cells(intRow, 1) ' the value in A2 
bolDelete = False 

Do While strContinue <> "" ' this loop will continue down each row as long as there is a value in column A 

    If Left(strContinue, 5) = "Under" Or Left(strContinue, 5) = "Navn:" Then 'change this to match your criteria 
     'delete the current row 
     Rows(intRow & ":" & intRow).Delete Shift:=xlUp 
     intRow = intRow - 1 ' because we deleted a row 
    End If 

    intRow = intRow + 1 
    strContinue = Cells(intRow, 1) 
Loop 

End Sub