Question

正如主题所说，我有一个vba代码可以完成工作：删除工作表“事件”的所有列，并只保留名称为“Status”，“Name”和“Age”的列

但由于某种原因，在几千行之后，它无法正常工作并删除了保留的列的数据/单元格，而且运行速度也很慢。

还有其他方法吗？更有效吗？至少不要删除必须保留在工作表中的那些列的任何单元格。

提前致谢（以下代码）。

Sub Cleanup_report2()
    Dim currentColumn As Integer
    Dim columnHeading As String

    For currentColumn = Worksheets("Incidents").UsedRange.Columns.CounT To 1 Step -1

        columnHeading = Worksheets("Incidents).UsedRange.Cells(1, currentColumn).Value

        'CHECK WHETHER TO KEEP THE COLUMN
        Select Case columnHeading

            Case "Status", "Name", "Age"
                'Do nothing
            Case Else

                If InStr(1, _
                    Worksheets("Incidents").UsedRange.Cells(1, currentColumn).Value, _
                   "DLP", vbBinaryCompare) = 0 Then

                     Worksheets("Incidents").Columns(currentColumn).Delete

                End If
        End Select
    Next

End Sub

Answer 1

只执行一次删除操作应该更快：

Sub Cleanup_report2()
    Dim currentColumn         As Integer
    Dim columnHeading         As String
    Dim rDelete               As Excel.Range

    With Worksheets("Incidents_data")

        For currentColumn = .UsedRange.Columns.Count To 1 Step -1

            columnHeading = .UsedRange.Cells(1, currentColumn).Value

            'CHECK WHETHER TO KEEP THE COLUMN
            Select Case columnHeading

                Case "Status", "Name", "Age"
                    'Do nothing
                Case Else

                    If InStr(1, columnHeading, "DLP", vbBinaryCompare) = 0 Then
                        If rDelete Is Nothing Then
                            Set rDelete = .UsedRange.Cells(1, currentColumn)
                        Else
                            Set rDelete = Union(rDelete, .UsedRange.Cells(1, currentColumn))
                        End If
                    End If
            End Select
        Next
    End With

    If Not rDelete Is Nothing Then rDelete.EntireColumn.Delete
End Sub

Answer 2

这是我的anser ...希望这有帮助...

Sub removeColumns()

    Dim rng As Range 'store the range you want to delete
    Dim c 'total count of columns
    Dim i 'an index
    Dim j 'another index
    Dim headName As String 'The text on the header
    Dim Status As String 'This vars is just to get the code cleaner
    Dim Name As String
    Dim Age As String
    Dim sht As Worksheet

    Status = "Status"
    Name = "Name"
    Age = "Age"
    Set sht = Sheets("Incidents")

    sht.Activate 'all the work in the sheet "Incidents"
    c = Range("A1").End(xlToRight).Column
    'From A1 to the left at the end, and then store the number
    'of the column, that is, the last column
    j = 0 'initialize the var
    For i = 1 To c 'all the numbers (heres is the columns) from 1 to c
        headName = Cells(1, i).Value
        If (headName <> Status) And (headName <> Name) And (headName <> Age) Then
        'if the header of the column is differente of any of the options
            j = j + 1 ' ini the counter
            If j = 1 Then 'if is the first then
                Set rng = Columns(i)
            Else
                Set rng = Union(rng, Columns(i))
            End If
         End If
    Next i
    rng.Delete 'then brutally erased from leaf
End Sub

VBA保留某些列并删除所有其他列

2 个答案: