Макрос VBA Excel - Удалить лист, если содержит только 1 столбец с текстом

Question

Совершенно новый для VBA, и я столкнулся с проблемой. У меня есть Excel с несколькими заполненными листами, которые затем загружены. Что я хочу сделать после загрузки, так это проверить, есть ли на каждом листе более 1 столбца содержимого, и если да, сохранить лист. Если он содержит только 1 столбец содержимого, удалите его.

Это необходимо удалить:

Это не:

Любая помощь будет очень принята. Спасибо

Answer 1

Попробуйте этот код, пожалуйста.

Отредактировано: чтобы ответить на ваш последний вопрос из комментария, начальный Sub будет адаптирован для вызова двух других подпрограмм, которые могут добавлять числа в существующие заголовки, чтобы сделать их уникальными:

Sub deleteSheetsOneColumn()
  Dim wb As Workbook, sh As Worksheet, nrCol As Long, i As Long
  Set wb = ActiveWorkbook
  For Each sh In wb.Worksheets
    If sh.Cells(1, Columns.Count).End(xlToLeft).Column = 1 Then
        Application.DisplayAlerts = False
         sh.Delete
        Application.DisplayAlerts = True
    Else
        'testUniQHeaders sh 'the simple solution (need to uncomment it and comment the next line
         testUniQueH sh 'comment the previous line, to make it working
    End If
  Next
End Sub

Код также удалит пустые листы ...

Следующая подпрограмма просто добавит увеличенное число к каждому существующему заголовку, что сделает он уникален:

Sub testUniQHeaders(sh As Worksheet)
 Dim nrCol As Long, i As Long

  nrCol = sh.Cells(1, Columns.Count).End(xlToLeft).Column
    For i = 1 To nrCol
        sh.Cells(1, i).Value = sh.Cells(1, i).Value & " " & i
    Next i
End Sub

Следующий, будет загружать каждый заголовок столбца в словарь сложным способом и использовать результат, чтобы адаптировать только заголовки, появляющиеся более одного раза:

Private Sub testUniQueH(sh As Worksheet)
 Dim nrCol As Long, i As Long, dict As Object, strH As String, key As Variant
 Dim arrK As Variant

 Set dict = CreateObject("Scripting.Dictionary")

  nrCol = sh.Cells(1, Columns.Count).End(xlToLeft).Column
  'input cols in the dictionary
    For i = 1 To nrCol
        strH = sh.Cells(1, i).Value
        If Not dict.Exists(strH) Then
            dict.aDD key:=strH, Item:=Array(1, i) 'init number plus column number
        Else
            dict(strH) = Array(dict(strH)(0) + 1, dict(strH)(1) & "|" & i) 'add occurrences and col no
        End If
    Next i

    For Each key In dict.Keys
        If CLng(dict(key)(0)) > 1 Then
            arrK = Split(dict(key)(1), "|")
            For i = 1 To UBound(arrK)
                sh.Cells(1, CLng(arrK(i))).Value = _
                    sh.Cells(1, CLng(arrK(i))).Value & " " & i
            Next i
        End If
    Next
End Sub