如果仅包含一列文字，则删除工作表

Question

我有一本包含多张纸的工作簿。

我想检查每张纸是否有多于一列的内容。如果没有删除。

必须将其删除：

这不是：

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