VBA-使用宏操作特定图纸数据-非活动图纸

VBA-使用宏操作特定图纸数据-非活动图纸,vba,excel,Vba,Excel,我的工作簿中有10张工作表-这些工作表是从单个工作簿中导入的-这些工作簿是从不同的监控工具中提取的 我需要在所有10张工作表上应用过滤器,但是,并非所有工作表的格式/结构都相同 对于6个工作表,列标题相同且顺序相同 其余4张图纸有不同的标题。例如:过滤器需要查找标题名称状态-这适用于具有相同结构的6张图纸,但其他4张图纸具有以下内容: wsheet1: 用户状态而不是状态-我需要将标题更改为状态 wsheet2: 当前状态而不是状态-我需要将标题更改为状态 下面是一个示例代码,它应该操作指定的工

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

我需要在所有10张工作表上应用过滤器,但是,并非所有工作表的格式/结构都相同

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

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

wsheet1:

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

wsheet2:

当前状态而不是状态-我需要将标题更改为状态

下面是一个示例代码,它应该操作指定的工作表,以便使其“外观”与其他工作表相同,但是,我遇到了一些非常恼人的问题,代码没有应用于指定的工作表,而是在执行宏时应用于“活动工作表”

以下是我的代码:

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
  • 考虑使用
    ,在
    With End With
    部分中,参考上述工作表:

  • 如果cel Like“*USER STATUS*”与
    *
    一起工作,则
    中的
    Like
    将被评估为
    12用户状态12
    或任何类似的值

  • count
    变量应该声明为variant,因此它可以在自身中保留“errors”

这就是代码的样子:

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
  • 考虑使用
    ,在
    With End With
    部分中,参考上述工作表:

  • 如果cel Like“*USER STATUS*”
    *
    一起工作,则
    中的
    Like
    将被评估为
    12用户状态12
    或任何类似的值

  • count
    变量应该声明为variant,因此它可以在自身中保留“errors”

这就是代码的样子:

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

如果希望工作簿中的所有工作表都有相同的页眉,只需从第一张工作表复制页眉并将其粘贴到每张工作表上即可

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

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
如果列标题的顺序不同,但您只想将包含文本“Status”的任何单元格替换为“Status”,则可以使用
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

如果希望工作簿中的所有工作表都有相同的页眉,只需从第一张工作表复制页眉并将其粘贴到每张工作表上即可

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

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
如果列标题的顺序不同,但您只想将包含文本“Status”的任何单元格替换为“Status”,则可以使用
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

我有另外的解决方案,这也有助于解决这个问题。代码如下:

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

我有另外的解决方案,这也有助于解决这个问题。代码如下:

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

你是说你所需要做的就是将
用户状态
更改为
wsheet1`上的状态,并将
当前状态
更改为
wsheet2上的状态
?这些都在同一个工作簿中运行吗?注意,排序的第一件事不是只使用单元格或区域,而是使用与之配套的工作表名称,否则它将默认为ActiveSheet。我需要对4个工作表进行一些更改,但我需要有关如何“聚焦”的帮助在正确的工作表上,然后我将处理操作工作表所需的代码。@ashleedawgThank@QHarr,我还在学习,所以我会在这些方面对自己进行更多的教育。你是说你所需要做的就是在
wsheet1`上将
用户状态
更改为
状态,在
wsheet2
上将
当前状态
更改为
状态?这些都在同一个工作簿中运行吗?注意,排序的第一件事不是只使用单元格或区域,而是使用与之配套的工作表名称,否则它将默认为ActiveSheet。我需要对4个工作表进行一些更改,但我需要有关如何“聚焦”的帮助在正确的工作表上,然后我将处理操作工作表所需的代码。@ashleedawgThank感谢您的回复@QHarr,我还在学习,因此我将在这些方面对自己进行更多的教育。感谢您的回复和帮助@Darren。很抱歉,在我的问题中,我忘了说我需要做一些更改,而不仅仅是重命名标题。否则你的代码会工作得很好,但是在四个不同标题的工作表上,它们的列数也不同,并且与其他6个工作表的顺序不同。我添加了代码来替换状态。不过,这不会给你一个字尾的数字。再次感谢你的回复。不幸的是,这段代码似乎对@Darren没有任何作用。我甚至创建了一个只有列标题的新工作簿并进行了测试,但什么也没发生。这很奇怪。我的测试工作簿有六张表格,每个单元格都包含文本“状态”:“当前状态”、“用户状态”、“此状态错误”和“不符合条件的状态”,它将每个单元格都改为“状态”。代码在包含要更改的文本的工作簿中-
ThisWorkbook
,标题在第1行?也许试着换一下