Question

我不太清楚我应该如何解决这个问题，但有两种方法对我有意义。

我工作簿中的某些工作表没有标题，因此我使用下面的代码插入一个空白行并为A列分配标题 - 我知道A列始终是员工编号。

Sub insertRow()

    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim wkbk1 As Workbook

    Set wkbk1 = Workbooks("testWorkbook.xlsm")

    'Set sheets to be used in each workbook
    Set ws1 = wkbk1.Sheets("mySheet")
    Set ws2 = wkbk1.Sheets("hisSheet")
    Set ws3 = wkbk1.Sheets("herSheet")

    wkbk1.Activate

    ws1.Range("A1").EntireRow.Insert
    ws1.Range("A1").Value = "Employee Number"

    ws2.Range("A1").EntireRow.Insert
    ws2.Range("A1").Value = "Employee Number"

    ws3.Range("A1").EntireRow.Insert
    ws3.Range("A1").Value = "Employee Number"

End Sub

以下代码根据标题名称删除列。

Sub ManipulateSheets()

    Dim a As Long, w As Long
    Dim keepCols As Variant
    Dim wkbk1 As Workbook

    Set wkbk1 = Workbooks("testWorkbook.xlsm")

    keepCols = Array("Employee Number", "Status")

    wkbk1.Activate

    With wkbk1

        For w = 1 To .Worksheets.count

            With Worksheets(w)

                For a = .Columns.count To 1 Step -1

                    If UBound(Filter(keepCols, .Cells(1, a), True, vbTextCompare)) < 0 Then _
                            .Columns(a).EntireColumn.Delete

                Next a

            End With

        Next w

    End With

End Sub

问题在于：

我插入一行并将列A的列标题设置为Employee Number的3张表，对于该行的其余部分仍然有空标题。所以当我运行上面的代码删除列时，没有任何反应在这3张纸上，因为没有数据可以在标题中进行比较。

所以我认为可行的两个选项是：

找到lastColumn并将文本插入A列和lastColumn之间的单元格
找到lastColumn并在if语句中包含查找空白单元格以及不匹配标题的条件

我在这里找到了找到lastColumn的代码：

Excel VBA- Finding the last column with data

Sub findColumn()

    Dim rLastCell As Range
    Dim i As Long
    Dim MyVar As Variant
    Dim ws1 As Worksheet
    Dim wkbk1 As Workbook
    i = 2

    Set wkbk1 = Workbooks("testWorkbook.xlsm")

    Set ws2 = wkbk1.Sheets("ws1")

    Set rLastCell = ws2.Cells.Find(What:="*", After:=ws2.Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)

End Sub

我正在考虑沿着以下方向行进的Do While循环：

Do While (MyVar1 >= 2 And MyVar1 < rLastCell.Column)



Loop

Answer 1

您可以将条件更改为

IsError(Application.Match(rng.Value, keepCols, 0))

选择所有不匹配的物品。

注意：

For Each rng In Intersect(.Rows(1), .UsedRange)

以上内容将循环显示所选工作表中第1行的已用范围。

循环多张表可能类似于：

Option Explicit

Sub test()

    Dim keepCols()
    keepCols = Array("Employee Number", "Status")

    Dim unionRng As Range, rng As Range, ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        With ws
            If Application.WorksheetFunction.CountA(.Rows(1)) > 0 Then
                For Each rng In Intersect(.Rows(1), .UsedRange)
                    If IsError(Application.Match(rng.Value, keepCols, 0)) Then
                        If Not unionRng Is Nothing Then
                            Set unionRng = Union(unionRng, rng)
                        Else
                            Set unionRng = rng
                        End If
                    End If
                Next rng
                If Not unionRng Is Nothing Then 
                    Debug.Print unionRng.EntireColumn.Address 'unionRng.EntireColumn.Delete '.  ''<== Swop when ready to delete
                    Set unionRng = Nothing
                End If
            End If
        End With
    Next ws
End Sub

VBA - 查找lastColumn并检查第一行是否为空

1 个答案: