VBA - 使用宏操作特定工作表数据 - 不是 Activesheet

Question

我的工作簿中有 10 张工作表 - 这些工作表是从各个工作簿中导入的 - 这些工作簿是从不同的监控工具中提取的

我需要对所有 10 个工作表应用过滤器，但是，并非所有工作表都采用相同的格式/结构。

对于 6 个工作表，列标题相同且顺序相同。

剩下的 4 张有不同的标题。例如：过滤器需要查找标题名称 Status - 这适用于具有相同结构的 6 个工作表，但是，其他 4 个工作表具有以下内容：

wsheet1：

用户状态 而不是 Status - 我需要将标题更改为 Status

wsheet2：

Current_Status 而不是 Status - 我需要将标题更改为 Status

下面是示例代码，它应该操纵 指定的工作表，以使其“看起来”与其他工作表相同，但是，我遇到了一些非常烦人的问题'不应用于指定的工作表，而是在执行宏时应用于“Activesheet”。

这是我的代码：

Sub arrangeSheets()

    Dim lastCol As Long, idCount As Long, nameCount As Long, headerRow As Long

    Dim worksh As Integer, WS_Count As Integer, i As Integer, count As Integer

    Dim rng As Range, cel As Range, rngData As Range

    Dim worksheetexists As Boolean

            worksh = Application.Sheets.count
            worksheetexists = False

            headerRow = 1       'row number with headers
            lastCol = Cells(headerRow, Columns.count).End(xlToLeft).Column 'last column in header row
            idCount = 1
            nameCount = 1


            ' Set WS_Count equal to the number of worksheets in the active
            ' workbook.
            WS_Count = ActiveWorkbook.Worksheets.count

            'If Application.Match finds no match it will throw an error so we need to skip them
            On Error Resume Next

            For x = 1 To worksh

                If Worksheets(x).Name = "wsheet1" Then
                    worksheetexists = True

                    Set rng = Sheets("wsheet1").Range(Cells(headerRow, 1), Cells(headerRow, lastCol)) 'header range

                    With Worksheets("wsheet1").Name

                        Rows(2).Delete
                        Rows(1).Delete
                        count = Application.Match("*USER STATUS*", Worksheets("wsheet1").Range("A1:AZ1"), 0)

                        If Not IsError(count) Then
                            For Each cel In rng                     'loop through each cell in header
                                If cel = "*USER STATUS*" Then       'check if header is "Unit ID"

                                    cel = "STATUS" & idCount        'rename "Unit ID" using idCount
                                    idCount = idCount + 1           'increment idCount

                                End If
                            Next cel
                        End If

                    End With

            Exit For

                End If

            Next x
            End Sub

Answer 1

• 考虑使用.，在With-End with 部分参考提到的工作表：

• If cel Like "*USER STATUS*" 中的Like 与* 一起使用，因此对于12USER STATUS12 或类似的东西，将评估为True。

• count 变量应声明为变体，因此它本身可以保留“错误”。

这就是代码的样子：

With Worksheets("wsheet1")

    .Rows(2).Delete
    .Rows(1).Delete
    Count = Application.Match("*USER STATUS*", .Range("A1:AZ1"), 0)

    If Not IsError(Count) Then
        For Each cel In Rng                     'loop through each cell in header
            If cel Like "*USER STATUS*" Then    'check if header is "Unit ID"
                cel = "STATUS" & idCount        'rename "Unit ID" using idCount
                idCount = idCount + 1           'increment idCount    
            End If
        Next cel
    End If

End With

Answer 2

如果您想在工作簿中的所有工作表中使用相同的标题，您可以从第一个工作表中复制标题并将它们粘贴到每个工作表上。

如果您的列顺序在工作表中不同，这将不起作用，但从您给出的示例来看，它只是重命名列而不是重新排序？

Sub CorrectHeaders()

    Dim cpyRng As Range

    With ThisWorkbook
        If .Worksheets.count > 1 Then

            With .Worksheets(1)
                Set cpyRng = .Range(.Cells(1, 1), .Cells(1, .Columns.count).End(xlToLeft))
            End With

            .Sheets.FillAcrossSheets cpyRng

        End If
    End With

End Sub

如果列标题的顺序不同，但您只想将包含文本“状态”的任何单元格替换为“状态”，那么您可以使用Replace。您可能需要添加MatchCase:=True 的额外条件。

Sub Correct_Status()

    Dim wrkSht As Worksheet

    For Each wrkSht In ThisWorkbook.Worksheets
        wrkSht.Cells(1, 1).EntireRow.Replace What:="*Status*", Replacement:="Status", LookAt:=xlWhole
    Next wrkSht

End Sub

Answer 3

我有其他解决方案也有助于解决此问题。代码如下：

Sub ManipulateSheets()

    Dim worksh As Integer

    Dim worksheetexists As Boolean

    worksh = Application.Sheets.count
    worksheetexists = False

    'If Application.Match finds no match it will throw an error so we need to skip them
    On Error Resume Next

    Worksheets("wSheet1").Activate

    With Worksheets("wSheet1")

        .Rows(2).Delete
        .Rows(1).Delete
    End With

    Worksheets("wSheet2").Activate

    With Worksheets("wSheet2")

        .Rows(2).Delete

    End With

End Sub