Удаление пустых столбцов в таблице

Posted by Chas under Basic

Скрипт
Код работает, если нет объединённых ячеек в таблице.
Код работает с таблицей, в которой находится курсор.

Для ускорения работы кода можно попробовать перейти в режим «Черновик» (Word 2010) и отключить проверку правописания.

Sub Procedure_1()

    '1. Помещаем в константу "myHeader" фрагмент заголовка

        'столбцов, которые нас интересуют.

    Const myHeader As String = "Семестр"
    Dim myTable As Word.Table

    Dim myLen As Long

    Dim i As Long, j As Long
    '2. Даём таблице, в которой находится курсор, VBA-имя "myTable".

    'Через это имя будем обращаться к этой таблице. Так удобнее писать код.

    Set myTable = Selection.Tables(1)
    '3. Берём в переменную "myLen" количество символов,

        'которое во фрагменте заголовка, чтобы каждый раз

        'не вызывать функцию "Len" (может это ускорит работу кода).

    myLen = Len(myHeader)
    'В цикле с "i" двигаемся по ячейкам первой строки таблицы.

    'Когда что-то удаляем, то удобнее писать код, если

        'двигаться с конца в начало, т.к. порядковые номера

        'элементов меняются.

    For i = myTable.Columns.Count To 1 Step -1

        'Если в ячейке в начале ячейки есть слово "Семестр",

            'то анализируем остальные ячейки столбца.

        If Left(myTable.Cell(1, i).Range.Text, myLen) = myHeader Then
            'В цикле с "j" двигаемся по ячейкам столбца.

            For j = 2 To myTable.Rows.Count Step 1
                'В каждой Word-ячейке есть всегда два символа:

                    '1) символ "Конец ячейки" (его видно, если включен

                        'режим отображения непечатаемых символов (он круглый));

                    '2) символ, которого вообще не видно никогда.

                'Characters учитывает символ "Конец ячейки".

                'Если в ячейке больше одного символа, значит ячейка не пустая.

                If myTable.Cell(j, i).Range.Characters.Count > 1 Then

                    'Переходим к следующему столбцу.

                    GoTo metka

                End If
            Next j
            'Если код дошёл до сюда, значит все ячейки

                'в столбце просмотрены и все ячейки пустые.

            'Удаляем столбец.

            myTable.Columns(i).Delete
        End If
metka:
    Next i
End Sub

тема на форуме

Похожие статьи

• Макрос, который находит повторяющийся текст при его вводе и выводит окно предупреждения
• Как в операторе автофильтра указать, что выбираются выбираются все значения, кроме нуля?
• Удалить кривую из графика
• Как создать макрос, который бы вставлял слово по первой набранной букве?
• Как в Word сделать элементы управления невидимыми для печати?
• Запуск макроса в открытом на данный момент Word
• Как макросом брать данные с word документов в excel?
• Срабатывание разных макросов при изменении разных диапазонов на листе
• Открыть несколько книг excel из одной папки с одинаковым расширением
• Копирование части текста (выделенного полужирным) из ячейки