Макро (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 .

Как я могу это сделать? Благодарю.

Это может сработать. Вы можете настроить фильтры и форматировать в соответствии с вашими потребностями. Однако будьте осторожны с макрозаписью.

 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 
  • Напишите «хороший» или «плохой», если значения в диапазоне истинны или ложны
  • IF для копирования и заполнения выбранных значений столбца Excel
  • Средние показания счетчика в часах
  • Excel, если Statement заменяет значение в столбцах
  • Кодирование в Excel
  • excel formula: return true, если ни одна из ячеек в диапазоне не заполнена
  • EXCEL - IF несколько строк в диапазоне ячеек
  • Формула Excel для поиска, если все ячейки в диапазоне читаются «Истинные», если нет, то покажите «False»,
  • Excel несколько вложенных, если и условия неоднократно повторялись
  • Суммирование на основе> = даты
  • Если, тогда, Дублировать формулу Excel
  • Interesting Posts

    Как записать в файл .xlsx с двумя предварительно определенными листами с помощью C #?

    Excel VBA – .xlam (AddIn) бросает подзаголовок вне диапазона Ошибка 9, но все работает как xlsm?

    Программно удалить источник данных Mailmerge с помощью VB.NET

    Подсчитайте по одному или нескольким критериям

    Увеличение адресов в строковом формате в Excel или Matlab?

    Оператор Excel = работает не так, как ожидается, с несколькими вкладками

    FilePath указывает на сопоставленный диск вместо фактического имени сервера

    декодирование .txt – «utf-8» кодек не может декодировать байт 0xf3

    VBA – Split STRING Функция с startPOS и endPOS

    Суммарное значение совпадения в excel

    Dwonload от конкретного отправителя и открыть в excel

    тип несоответствия по диапазону debug.print (index)

    Самый быстрый способ записи ячеек в Excel с помощью Office Interop?

    Excel Open xml sdk – Копировать формулу между ячейками с модификацией диапазона

    Excel VBA: Итерация через содержимое DIV – Вставить в отдельные ячейки

    Давайте будем гением компьютера.