Удаление столбцов на основе эталонного листа VBA

Question

У меня есть справочный лист в книге, который включает имя рабочего листа и все заголовки из всех файлов, включенных в эту специальную книгу. Я хотел бы использовать этот справочный лист для удаления нежелательных столбцов из каждого соответствующего листа. Процесс состоит в том, чтобы очистить от 60 до 100 файлов, которые были объединены в одну книгу как отдельные рабочие листы.

В справочном листе есть все имена рабочих листов в столбце A, а заголовки - от B до AH. Есть ли способ, чтобы я мог выделить каждую красную запись, которую я хочу удалить, а затем запустить VBA для проверки ссылочного листа, для которого столбцы должны быть удалены из каждого соответствующего листа. Я надеюсь, что кто-нибудь запустит меня или назовет меня в направлении процесса, на который я мог бы ссылаться, чтобы это сделать? Я пробовал Google, но безрезультатно. Я честно даже не знаю, как я начну.

Answer 1

Если я прочитал ваш Q правильно, работа поток:

1. цикла по ссылке данные листа
2. Получить ссылку на указанный лист
3. Цикл по ссылке листов ряда, глядя на красный цвет
4. Для каждого найденного красного цвета найдите строку заголовка таблицы поиска для заголовка текста заголовка
5. Если найдено, удалите столбец

Пример кода, чтобы начать с (есть несколько предположений в здесь, что может потребоваться корректировка)

Sub DeleteHeaders() 
    Dim wsRef As Worksheet 
    Dim ws As Worksheet 
    Dim rRef As Range, rRow As Range 
    Dim cl As Range 
    Dim rHeader As Range 

    Dim RED As Long 

    RED = RGB(255, 0, 0) 
    Set wsRef = Worksheets("NameOfReferenceWorksheet") 
    ' Get reference to all data on reference sheet 
    With wsRef 
     Set rRef = .Range(.Cells(2, 34), .Cells(.Rows.Count).End(xlUp)) 
    End With 

    For Each rRow In rRef 
     ' Get reference to listed worksheet 
     On Error Resume Next 
     Set ws = Worksheets(rRow.Cells(1, 1)) 
     If Err.Number <> 0 Then 
      ' Worksheet not present in workbook. What now? 
      On Error GoTo 0 
     Else 
      ' loop over the row 
      On Error GoTo 0 
      For Each cl In rRow.Offset(0, 1).Resize(1, rRow.Columns.Count - 1) 
       If cl.Interior.Color = RED Then 
        Set rHeader = Nothing 
        ' search for highlighted header text 
        With ws.Rows(1) '<-- header text in row 1 
         Set rHeader = .Find(_ 
          What:=cl.Value, _ 
          After:=.Cells(1, 1), _ 
          LookIn:=xlValues, _ 
          LookAt:=xlWhole, _ 
          SearchOrder:=xlByRows, _ 
          SearchDirection:=xlNext, _ 
          MatchCase:=True, _ 
          SearchFormat:=False) 
         If rHeader Is Nothing Then 
          ' Header not found. What now? 
         Else 
          ' delete entire column 
          rHeader.EntireColumn.Delete 
          ' Optional: clear colour 
          cl.Interior.Pattern = xlNone 
         End If 
        End With 
       End If 
      Next 
     End If 
    Next 
End Sub