Блог

У меня есть рабочая книга с большим количеством листов, содержащих разное количество столбцов. На каждом листе есть столбец с заголовком «TOTAL.x», где x — номер листа. Я пытаюсь найти столбец TOTAL на каждом листе и переместить его в одну и ту же позицию, поэтому, когда листы объединяются в один лист, все столбцы TOTAL находятся в одном столбце.

Вот минимальный пример листов, чтобы лучше объяснить, что я пытаюсь получить:

Лист1:

Лист2:

Лист3:

В приведенном выше примере целью было бы переместить ОБЩИЙ столбец в столбец G на всех листах. Что эквивалентно вставке различного количества пустых столбцов перед ОБЩИМ столбцом на каждом листе, соответственно 1, 4 и 0.

Его можно разделить на следующие две задачи:

1. Найдите ОБЩИЙ столбец на каждом листе и переместите его в столбец справа от наибольшего диапазона данных. (В приведенном выше примере любой столбец справа от столбца G)
2. На каждом листе проверяйте, пуст ли столбец A, если он пуст на всех листах, удалите его на всех листах, если нет, перейдите к следующему столбцу, перейдите к столбцу, выбранному для задачы1.

У меня почти есть задача 1:

 Sub Task1()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim starting_ws As Worksheet
Set starting_ws = ActiveSheet
For Each ws In ThisWorkbook.Worksheets
    ws.Activate
    Dim search As Range
    Set search = Rows("1:1").Find("TOTAL", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
    If Not search Is Nothing Then
        Application.CutCopyMode = False
        search.EntireColumn.Cut
        Columns("J").Select
        Selection.Insert Shift:=xlToRight
        Application.CutCopyMode = False
    End If
Next
starting_ws.Activate
End Sub
  

Вопрос1: (РЕШАЕМЫЙ)

Я могу заставить его работать, только если заголовок столбца TOTAL равен «TOTAL», а не когда TOTAL — это просто префикс фактического имени заголовка соответственно «TOTAL.1», «TOTAL.2» и «TOTAL.3». Решением может быть либо заставить его работать с префиксом TOTAL, либо заменить ‘TOTAL.x’ на ‘TOTAL’.

Вопрос2:

Я понятия не имею, как проверить, является ли определенный столбец пустым на всех листах, и если это правда, удалите столбец на всех листах.

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

Обновить

Задача 1 теперь решена.

Что касается задачи 1, мне пришлось внести некоторые исправления, чтобы заставить ее работать на моем собственном компьютере. Вот оно, и оно отлично работает. Я работаю над задачей 2 и опубликую обновление.

 Sub Task1()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim starting_ws As Worksheet
Set starting_ws = ActiveSheet

For Each ws In Worksheets

    MsgBox "This is fun" amp; ws.Name

    ws.Activate
    Dim search As Range
    Set search = ws.Rows("1:1").Find("TOTAL", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
    If Not search Is Nothing Then
        Application.CutCopyMode = False
        search.EntireColumn.Cut
        ws.Columns("J").Select
        Selection.Insert Shift:=xlToRight
        Application.CutCopyMode = False
    End If
    
    MsgBox "END-This is fun" amp; ws.Name
Next
starting_ws.Activate
End Sub
  

Обновить

Для задачи 2 я использую счетчик и выполняю проверку концепции. Вот оно, кажется, работает на моем ПК:

 Sub Task2()

Dim ws As Worksheet
Dim starting_ws As Worksheet
Set starting_ws = ActiveSheet

Dim deleteColumn As Boolean

Dim totalColumnsToCheck
Dim currentIterations

totalColumnsToCheck = 20
currentIterations = 0

For c = 1 To totalColumnsToCheck

    deleteColumn = True

    For Each ws In Worksheets
    
         ws.Activate
        
        If WorksheetFunction.CountA(ws.Columns(c)) > 0 Then
            deleteColumn = False
        Else
            
        End If

    Next

    If deleteColumn Then
     For Each ws In Worksheets
             ws.Activate
             ws.Columns(c).EntireColumn.Delete
        Next
        totalColumnsToCheck = totalColumnsToCheck - 1
        
        If c > 0 Then
            c = c - 1
        End If
        
    End If
    
    currentIterations = currentIterations   1
    
    If currentIterations > totalColumnsToCheck Then
        Exit For
    End If

Next c


starting_ws.Activate


End Sub