Question

我正在尝试删除Excel工作表中的所有列除以外，其标题为“产品代码”，“尺寸”和“数量”的列。

我写了以下代码。

Sub delcolumns()
    Dim Rng As Range
    Dim cell As Range
    Set Rng = Range(("A1"), Range("A1").End(xlToRight))
    For Each cell In Rng
        If cell.Value <> "Product Code" Or "Size" Or "Quantity" Then cell.EntireColumn.Delete
        Next cell
End Sub

运行微型计算机后，错误提示“类型不匹配”

Answer 1

在删除行或列时应该向后工作，否则可能会跳过一个或多个。

Sub delcolumns()

    Dim c as long, cols as variant

    cols = array("Product Code", "Size", "Quantity")

    for c = cells(1, columns.count).end(xltoleft).column to 1 step -1
        if iserror(application.match(cells(1, c).value, cols, 0)) then
             columns(c).entirecolumn.delete
        end if
    next c

End Sub

'alternative
Sub delcolumns()

    Dim c as long

    for c = cells(1, columns.count).end(xltoleft).column to 1 step -1
        select case cells(1, c).value
            case "Product Code", "Size", "Quantity"
                'do nothing
            case else
                columns(c).entirecolumn.delete
        end select
    next c

End Sub

就您自己的代码而言，有两个问题。

If cell.Value <> "Product Code" Or "Size" Or "Quantity" Then cell.EntireColumn.Delete

上面的行是不正确的语法。每个条件都需要写明。

If cell.Value <> "Product Code" Or cell.Value <> "Size" Or cell.Value <> "Quantity" Then cell.EntireColumn.Delete

有关替代方法，请参见Is variable required instead of “or”。

更重要的是，您的逻辑有缺陷。如果一列是产品代码，则它不是 Size 或 Quantity ，它将被删除。你真的想要，

If cell.Value <> "Product Code" AND cell.Value <> "Size" AND cell.Value <> "Quantity" Then cell.EntireColumn.Delete

使用And代替Or表示该列不是三列中的一个，然后删除。

Answer 2

您无需使用此代码向后删除。由于动作不在循环中，因此这种方法往往效率更高。

假设您有20列，并打算删除其中的17列（保留需要的3列）。这意味着您将删除列并移动行的17次迭代。

相反，请跟踪要使用Union（单元格的集合）删除的目标列，然后在循环外一次删除所有内容。无论您需要删除多少列，您都将始终在一次实例中完成所有操作，而不是 n 实例。要删除的列数越多，使用此方法的收益就越大。

Option Explicit

Sub DeleteMe()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<-- Update sheet
Dim LC As Long, MyHeader As Range, DeleteMe As Range
LC = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

For Each MyHeader In ws.Range(ws.Cells(1, 1), ws.Cells(1, LC))
    Select Case MyHeader
        Case "Product code", "Size", "Quantity"
        Case Else
            If Not DeleteMe Is Nothing Then
                Set DeleteMe = Union(DeleteMe, MyHeader)
            Else
                Set DeleteMe = MyHeader
            End If
    End Select
Next MyHeader

If Not DeleteMe Is Nothing Then DeleteMe.EntireColumn.Delete

End Sub

Answer 3

回写经过调整大小的数组而没有向后循环

除了上述有效的解决方案之外，为了展示使用高级功能的替代方法， Application.Index函数：所有操作均在 array 中执行，然后再写回到工作表中。

方法

Application.Index函数不仅允许将行号和列号作为参数接收，而且还允许行列和列 arrays 具有某些重构的可能性。行数组包含完整的行集，列数组由辅助函数getColNums()构建，该函数包含与所需标题“产品代码”，“大小”和“数量”相关的列号。 -您可能会在Insert first column in datafield array without loops or API call上发现此功能的一些有趣之处。

代码示例

此代码示例假定一个数据范围A1:F1000，可以根据需要轻松更改。

Sub RestructureColumns()
  Dim rng As Range, titles(), v
  titles = Array("Product code", "Size", "Quantity")            ' << define wanted column titles
  Set rng = ThisWorkbook.Worksheets("Sheet1").Range("A1:F1000") ' << change to wanted sheet and data range
' [1a] create 2-dim data field array (1-based)
  v = rng.Value2
' [1b] filter out columns to be deleted, i.e. maintain the rest
  v = Application.Index(v, Evaluate("row(1:" & rng.Rows.count & ")"), getColNums(v, titles))
' [2] write data field back to resized range
  rng = ""                                  ' clear lines
  rng.Resize(UBound(v), UBound(v, 2)) = v   ' write back only columns with predefined titles
End Sub

'助手功能getColNums()

Function getColNums(v, titles) As Variant()
' Purpose: return array of column numbers related to wanted titles, e.g. 1st, 3rd and 6th column
  Dim tmpAr, title, foundCol, i&                                        ' declare variables
  ReDim tmpAr(0 To UBound(titles))                                      ' dimension array to titles length
  For Each title In titles                                              ' check the wanted titles only ...
     foundCol = Application.Match(title, Application.Index(v, 1, 0), 0) ' ... against the complete title row
     If Not IsError(foundCol) Then tmpAr(i) = foundCol:   i = i + 1     ' if found add col no, increment counter
  Next title
  ReDim Preserve tmpAr(0 To i - 1)                                      ' (redundant if all titles available)
  getColNums = tmpAr                                                    ' return built array
End Function

根据列标题删除整个列

3 个答案: