Question

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

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

使用6个工作表，列标题相同且顺序相同。

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

wsheet1：

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

wsheet2：

Current_Status 而非状态 - 我需要将标题更改为状态

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

这是我的代码：

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来引用上述工作表：

Like中的If cel Like "*USER STATUS*"与*一起使用，因此会True评估12USER STATUS12或类似内容。
count变量应声明为变体，因此可以保留＆＃34;错误＆＃34;本身。

这就是代码的样子：

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

VBA - 使用宏操作特定表单数据 - 非活动表

3 个答案: