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

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 列的列标题设置为员工编号的 3 张工作表，该行的其余部分仍然有空标题。所以当我运行上面的代码删除列时，没有任何反应在这 3 张纸上，因为标题中没有可比较的数据。

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

1. 找到lastColumn并将文本插入A列和lastColumn之间的单元格

2. 找到 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