Макро (VBA) в Excel для добавления границ и слияния ячеек, если ячейки не пусты
Я записал следующий макрос:
Sub Macro1() Range("E66:F68").Select Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone Range("D66:D68,C66:C68,B66:B68,A66:A68").Select Range("A66").Activate With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Selection.Merge With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext End With Selection.Borders(xlDiagonalDown).LineStyle = xlNone Selection.Borders(xlDiagonalUp).LineStyle = xlNone With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With Selection.Borders(xlInsideVertical).LineStyle = xlNone Selection.Borders(xlInsideHorizontal).LineStyle = xlNone Range("G73").Select End Sub Теперь это было записано для диапазона, начинающегося с E66, и в основном добавляет границы для выбранных ячеек и объединяет строки ячеек в соседних столбцах. То, что я хотел бы сделать, это добавить условие, которое смотрит на столбец E и запускает макрос в первой непустой ячейке, которая не имеет границ и заканчивает ее в последней непустой ячейке. В записанном макросе первая незамкнутая непустая ячейка составляла E66 (это означало, что ячейки в диапазоне E1: E65 имели все границы по крайней мере на одной стороне), а последняя непустая ячейка была E68 (диапазон на вторая строка – E66: F68, потому что я использовал внешние границы для прямоугольника ячеек от E66 до F68, но условие должно быть проверено только для столбца E).
Другими словами, мне нужен какой-то цикл, который идет от E1 до E x , и когда он обнаруживает ячейку, которая является непустой и нераспределенной, она сохраняет номер ячейки в качестве начальной ячейки (например, E y ). Затем, когда он находит пустую ячейку (например, E z ), цикл останавливается, и ячейка перед E z (так что E z-1 ) сохраняется как последняя. Затем макрос, который я записал, должен работать в диапазоне E y : F z-1 .
- Если (stmt)> False> Eval next row
- Функция Excel «IF».
- IF ... (AND) ошибка времени выполнения инструкции "13"
- AVERAGEIF со средним значением
- Функция, использующая IF и AND и OR для диапазона ячеек
Как я могу это сделать? Благодарю.
- Сравнить пользовательские данные в сводной таблице
- `IF` с тремя возможными ответами, каждый из которых основан на 3 разных диапазонах
- Запись инструкции MATCH или LOOKUP с предварительным условием
- Функция возврата «слишком низкая», «слишком высокая» или «ОК» для каждой ячейки в диапазоне
- Суммировать значения операторов if для нескольких строк? (Excel)
- Различия между двумя столбцами
- Формула Excel Countifs
- Как удалить строки, если ячейки выполняются, если условия
Это может сработать. Вы можете настроить фильтры и форматировать в соответствии с вашими потребностями. Однако будьте осторожны с макрозаписью.
Sub FindAreas() TopRange = 1 LastRow = Cells.Find(What:="*", After:=[A1], SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row For A = 1 To LastRow If Range("A" & A).Value <> "" _ And Range("A" & A).Borders(xlEdgeLeft).LineStyle = xlNone _ And Range("A" & A).Borders(xlEdgeRight).LineStyle = xlNone _ And Range("A" & A).Borders(xlEdgeTop).LineStyle = xlNone _ And Range("A" & A).Borders(xlEdgeBottom).LineStyle = xlNone _ Then Contiguous = True Else Contiguous = False If A = LastRow Then Contiguous = False A = A + 1 End If Select Case Contiguous Case False Call ApplyFormattingtoArea("A" & TopRange & ":A" & A - 1) TopRange = A + 1 A = A + 1 End Select Next A End Sub Sub ApplyFormattingtoArea(AppliedArea) Application.DisplayAlerts = False Range(AppliedArea).Merge Range(AppliedArea).Borders(xlInsideVertical).LineStyle = xlNone Range(AppliedArea).Borders(xlInsideHorizontal).LineStyle = xlNone With Range(AppliedArea) .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext End With Range(AppliedArea).Borders(xlDiagonalDown).LineStyle = xlNone Range(AppliedArea).Borders(xlDiagonalUp).LineStyle = xlNone With Range(AppliedArea).Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Range(AppliedArea).Borders(xlEdgeTop) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Range(AppliedArea).Borders(xlEdgeBottom) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Range(AppliedArea).Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With Application.DisplayAlerts = True End Sub