如果标题包含特定string，则删除列

如果标题是"Column 1"或"Column 2"等，我想删除列

我试图修改下面的代码，以便它将“列x”添加到字典，然后删除列，如果它包含的话 – 我做错了什么？

 Sub Macro2() Set Dict_Col = CreateObject("Scripting.Dictionary") ArrayCol = Sheets("Sheet2").Range(Cells(1, 1).Address, Cells(Rows.Count).End(xlUp).Address) ' I'm not sure what to add as a wildcard to the x? Dict_Col.Add UCase(Trim("Column x")), 1 For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1 If Dict_Col.Exists(UCase(Trim(Cells(1, i).Value))) Then Cells(1, i).EntireColumn.Delete End If Next i End Sub 

Answer 1

对于这个任务，Scripting.Dictionary是完全不必要的。

1. 在循环中UsedRange的标题行
2. 检查列名是否具有正确的格式
3. 收集Range对象中的匹配列（通过Application.Union() ）
4. 最后一步删除该Range对象。

另外，考虑一个比Macro2更好的名字。

 Sub Macro2() Dim header As Range, toRemove As Range Dim parts As Variant For Each header In Sheets("Sheet2").UsedRange.Rows(1).Cells parts = Split(header.Value, " ") If UBound(parts) = 1 Then If parts(0) = "Column" And IsNumeric(parts(1)) Then If toRemove Is Nothing Then Set toRemove = header.EntireColumn Else Set toRemove = Application.Union(toRemove, header.EntireColumn) End If End If End If Next header If toRemove Is Nothing Then MsgBox "Nothing found." Else toRemove.Delete End If End Sub 

（未经testing，我目前没有Excel，但总体思路应该是明显的。）

Answer 2

另一种解决scheme

 Option Explicit Sub delcolumns() With ThisWorkbook.Worksheets("Sheet2") .Rows(1).Insert .Rows(2).SpecialCells(xlCellTypeConstants, xlTextValues).Offset(-1).FormulaR1C1 = "=IF( COUNTIF(R[+1]C,""Column ?"") + COUNTIF(R[+1]C,""Column ??"") + COUNTIF(R[+1]C,""Column ???"") >0 ,1,"""")" .Rows(1).SpecialCells(xlCellTypeFormulas).Value = .SpecialCells(xlCellTypeFormulas).Value .Rows(1).SpecialCells(xlCellTypeConstants, xlNumbers).EntireColumn.Delete .Rows(1).Delete End With End Sub 

• 没有迭代
• 使用一个辅助行（在end子之前插入和删除）
• 假定“列”之后的数字最多可以是3位数字。 如果不是只适应公式

Answer 3

 Sub Macro2() Set Dict_Col = CreateObject("Scripting.Dictionary") ArrayCol = Sheets("Sheet2").Range(Cells(1, 1).Address, Cells(Rows.Count).End(xlUp).Address) Dict_Col.Add UCase(Trim("Column")), 1 For x = 2 To 100 Dict_Col.Add UCase(Trim("Column" & x)), x Next x For i = Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1 If Dict_Col.Exists(UCase(Trim(Cells(1, i).Value))) Then Cells(1, i).EntireColumn.Delete End If Next i End Sub