Excel 删除列，然后从其他列表中删除行

先删除列，然后删除行-谢谢@vbasic208

各位专家好!

我是VBA新手，我正试图从我们的专家@VBASIC208处改编这段代码

• 最重要的是，我需要将第一行改为第3行，而不是第1行。
• 如果可能的话，我还需要比较第一列。我的第一列必须始终是A3列=“房间”（有时在所提供表格的第一列，但有时在第四列）。A3，因为，如前所述，我需要将标题放在第3行

非常感谢您的宝贵帮助

---

描述

从列表中删除第一行中不包含值的列。然后从另一个列表中删除第一列中不包含值的行

流动

• 将范围A2到Sheet3中最后一个单元格的值写入Cols数组
• 将范围A2到Sheet2中最后一个单元格的值写入代理数组
• 使用CurrentRegion定义数据集范围（rng）
• 从第二列开始循环第一行中的单元格（cel），并将其值与Cols数组中的值进行比较。如果未找到，则将单元格添加到删除范围（rngDel）
• 最后删除“已收集”单元格的整列
• 从第二行开始循环第一列中的单元格（cel），并将其值与代理数组中的值进行比较。如果未找到，则将单元格添加到删除范围（rngDel）
• 最后删除“已收集”单元格的整行
• 通知用户操作是否成功

代码

    Option Explicit
    
    Sub ModifyTICBData()
    
        ' Define workbook ('wb').
        Dim wb As Workbook
        Set wb = ThisWorkbook
        
        ' Define Columns List ('Cols').
        Dim ws As Worksheet
        Set ws = wb.Worksheets("Sheet3")
        Dim rng As Range
        Set rng = ws.Cells(ws.Rows.Count, "A").End(xlUp)
        Dim Cols As Variant
    Cols = ws.Range("A2", rng).Value
    
    ' Define Agents List ('Agents').
    Set ws = wb.Worksheets("Sheet2")
    Set rng = ws.Cells(ws.Rows.Count, "A").End(xlUp)
    Dim Agents As Variant
    Agents = ws.Range("A2", rng).Value
    
    ' Define DataSet Range ('rng').
    Set rng = wb.Worksheets("Template").Range("A1").CurrentRegion
    
    Application.ScreenUpdating = False
    
    ' Define Delete Range ('rngDel') for Columns.
    Dim rngDel As Range
    Dim cel As Range
    For Each cel In rng.Rows(1).Resize(, rng.Columns.Count - 1) _
                               .Offset(, 1).Cells
        If IsError(Application.Match(cel.Value, Cols, 0)) Then
            collectCells rngDel, cel
        End If
    Next cel
    ' Delete Columns.
    Dim AlreadyDeleted As Boolean
    If Not rngDel Is Nothing Then
        rngDel.EntireColumn.Delete
    Else
        AlreadyDeleted = True
    End If
    
    ' Define Delete Range ('rngDel') for Agents.
    Set rngDel = Nothing
    For Each cel In rng.Columns("A").Resize(rng.Rows.Count - 1) _
                                    .Offset(1).Cells
        If IsError(Application.Match(cel.Value, Agents, 0)) Then
            collectCells rngDel, cel
        End If
    Next cel
    ' Delete Agents (Rows).
    If Not rngDel Is Nothing Then
        rngDel.EntireRow.Delete
        AlreadyDeleted = False
    End If
    
    Application.ScreenUpdating = True

    ' Inform user
    If Not AlreadyDeleted Then
        MsgBox "The data was succesfully deleted.", vbInformation, "Success"
    Else
        MsgBox "The data had already been deleted.", vbExclamation, "No Action"
    End If
    
End Sub

Sub collectCells(ByRef CollectRange As Range, CollectCell As Range)
    If Not CollectCell Is Nothing Then
        If Not CollectRange Is Nothing Then
            Set CollectRange = Union(CollectRange, CollectCell)
        Else
            Set CollectRange = CollectCell
        End If
    End If
End Sub