Question

我有一个适用于一张纸的代码。我当前的设置正在改变，我需要为工作簿中的每个工作表运行相同的代码。

我能够通过此代码获取所有内容，但是当它恢复为Sub Test（）时它不会更改工作表：

Sub Test()
    Dim lstrow As Long, sht As Worksheet


        For Each sht In ActiveWorkbook.Worksheets
            Call Dupe_Sub
        Next
End Sub

Sub Dupe_Sub()
'Highlight Duplicate Values
Dim sht As Worksheet, lstrow As Long, srcsht As Worksheet
Const UPCCol = "A"

Set srcsht = ActiveWorkbook.ActiveSheet
Set sht = ActiveWorkbook.ActiveSheet
lstrow = sht.Range("A1").CurrentRegion.Rows.Count

    With sht
        Columns("A:A").Select
        Selection.FormatConditions.AddUniqueValues
        Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
        Selection.FormatConditions(1).DupeUnique = xlDuplicate
        With Selection.FormatConditions(1).Font
            .Color = -16383844
            .TintAndShade = 0
        End With
        With Selection.FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .Color = 13551615
            .TintAndShade = 0
        End With
        Selection.FormatConditions(1).StopIfTrue = False

    'Sort Duplicates to top
        Range("A1").Select
        Selection.AutoFilter
        With sht

            .AutoFilter.Sort.SortFields.Add(Range( _
                "A1:A" & lstrow), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color _
                = RGB(255, 199, 206)
            With .AutoFilter.Sort
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End With
    End With
    Selection.AutoFilter
End Sub

Answer 1

在Sub Test（）中的

我会在调用Dupe_Sub之前添加一行激活每个工作表......

在我看来，您的代码为每个工作表运行一次，但由于它不会更改ActiveSheet，因此它会在同一个工作表上反复运行。

Answer 2

Sub Test()
  Dim lstrow As Long, sht As Worksheet


    For Each sht In ActiveWorkbook.Worksheets
        Call Dupe_Sub sht
    Next
  End Sub

  Sub Dupe_Sub(sht as Worksheet)
  'Highlight Duplicate Values
  Dim sht As Worksheet, lstrow As Long, srcsht As Worksheet
  Const UPCCol = "A"

  lstrow = sht.Range("A1").CurrentRegion.Rows.Count

  With sht.Columns("A:A")
    .FormatConditions.AddUniqueValues
    .FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    .FormatConditions(1).DupeUnique = xlDuplicate
    With .FormatConditions(1).Font
        .Color = -16383844
        .TintAndShade = 0
    End With
    With .FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 13551615
        .TintAndShade = 0
  End With
    .FormatConditions(1).StopIfTrue = False

  'Sort Duplicates to top
    Range("A1").AutoFilter

end with
    With sht

        .AutoFilter.Sort.SortFields.Add(Range( _
            "A1:A" & lstrow), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color _
            = RGB(255, 199, 206)
        With .AutoFilter.Sort
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
  Range("A1").AutoFilter
End Sub

Answer 3

在Dupe_Sub的最后，我实际上实现了我的目标

If ActiveSheet.Index = Worksheets.Count Then
Worksheets(1).Select
Else
ActiveSheet.Next.Select
End If

感谢您提出建议，我会考虑取消所有＆＃34;激活。＆＃34;

循环到下一个工作表

3 个答案: