VBA 宏在家用计算机上运行良好，但在工作计算机上停止。另外，我可以压缩一下吗？

问题描述 投票：0回答：1

我对编码非常陌生，但希望自动化我的一些 Excel 工作流程。我的工作机器在尝试从最大到最小过滤时似乎遇到了问题，但我的家用机器表现得很好。

它停在“.Apply”部分并给我一个错误

运行时错误“1004”。
应用程序定义或对象定义的错误。

我太新了，不知道它是什么以及如何修复它。我一周前开始学习这一切。

我在将过滤器正确应用到我的工作机器上时也遇到了问题。我不知道如何解决这个问题，所以我只是删除最初应用它们的人设置的初始过滤器，并让宏重新添加它们。有时过滤器存在，有时不存在。使用我当前的行来应用过滤器，如果应用了过滤器，则将其删除；如果过滤器丢失，则应用它们。如果它们不存在，我希望它添加它们，或者如果它们存在，就像我的家用机器一样，什么都不做。

我的工作机器和我家一样使用Office 16。

此外，如果有人对如何整合我的代码有任何提示，我们也会非常感激，但绝对不是必需的。我使用了宏记录器的所有条件格式部分。

这是给我带来麻烦的部分（使用宏记录器完成）：

    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:= _
        Range("H:H"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply

完整内容如下：

Sub Test()

' Formatting of 1st Row

    Range("A1:Y1").Select
    With Selection.Font
        .Bold = True
        .Underline = True
        .Size = 12
    End With

' Selects all cells within the sheet and changes the font to Times New Roman

    Cells.Select
    Selection.Font.Name = "Times New Roman"

' Adds filters if Sheet doesn't already have them

    If Not Sheets(1).AutoFilterMode Then Range("A1: Y1").AutoFilter

' Auto Fit Columns then Rows

    Cells.Select
    Selection.Columns.AutoFit
    Selection.Rows.AutoFit

' Adds conditional formatting to the sheet to highlight rows based on cell values and sometimes just the cell

' Conditional Formatting for (Column M) reflecting XXXX

    Columns("A:Y").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=$M1=""XXXX"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent6
        .TintAndShade = 0.599963377788629
    End With
    Selection.FormatConditions(1).StopIfTrue = False

' Conditional Formatting for Column M reflecting XXXX2

    Columns("A:Y").Select
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=$M1=""XXXX2"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.399945066682944
    End With
    Selection.FormatConditions(1).StopIfTrue = False

' Conditional Formatting for Column K reflecting XXXX

    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=$K1=""XXXX"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.399945066682943
    End With

' Conditional Formatting for Column K reflecting XXXX2

    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=$K1=""XXXX2"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.399945066682943
    End With
    Selection.FormatConditions(1).StopIfTrue = False

' Conditional Formatting for Column K reflecting XXXX3

    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=$K1=""XXXX3"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.399945066682943
    End With
    Selection.FormatConditions(1).StopIfTrue = False

' Conditional Formatting for Column K reflecting XXXX4

    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=$K1=""XXXX4"""
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent2
        .TintAndShade = 0.399945066682943
    End With
    Selection.FormatConditions(1).StopIfTrue = False

' Conditional Formatting for Column R reflecting a value between 200 & 1

    Columns("R:R").Select
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, \_
        Formula1:="=200", Formula2:="=1"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
         .ThemeColor = xlThemeColorDark1
         .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
         .PatternColorIndex = xlAutomatic
         .Color = 192
         .TintAndShade = 0
    End With

' Conditional Formatting for Column R reflecting text of "EXP"

    Selection.FormatConditions(1).StopIfTrue = False
    Selection.FormatConditions.Add Type:=xlTextString, String:="EXP", _
        TextOperator:=xlContains
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = 192
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False

    'Conditional Formatting for top 15 Oldest Cases & Bold
    Columns("H:H").Select
    Selection.FormatConditions.AddTop10
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1)
        .TopBottom = xlTop10Top
        .Rank = 15
    End With
    With Selection.FormatConditions(1).Font
        .Bold = True
        .Italic = False
        .TintAndShade = 0
    End With
    With Selection.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent1
        .TintAndShade = 0.399945066682943
    End With
    Selection.FormatConditions(1).StopIfTrue = False

'Sort Column H by Largest to Smallest

    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:= _
        Range("H:H"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
        :=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

End Sub
excel vba sorting autofilter
1个回答
0
投票

改进宏记录器代码：条件格式和排序

Sub ApplyConditionalFormattingAndSort()

    ' Reference the workbook.
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    ' If it isn't, reference it by its tab name or use 'ActiveWorkbook'.
   
    ' Reference the worksheet.
    Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
    ws.AutoFilterMode = False ' turn off auto-filtering
    ' Why? Someone might have filtered only a single or a few columns.
    
    ' Set font for whole worksheet.
    ws.Cells.Font.Name = "Times New Roman"
    ' Note that this takes a lot of time. Maybe you should consider
    ' getting rid of it or applying it only to the range.
    
    ' Clear existing conditional formats.
    ' If you don't do this, you'll end up with duplicate formats.
    ws.Cells.FormatConditions.Delete
    
    ' Reference the range.
    Dim rg As Range: Set rg = ws.Range("A1").CurrentRegion
    rg.AutoFilter ' turn on auto-filtering for the range
    
    With rg
        
        ' Format headers.
        With rg.Rows(1)
            With .Font
                .Bold = True
                .Underline = True
                .Size = 12
            End With
            
        End With
        
        ' Autofit columns and rows.
        .EntireColumn.AutoFit
        .EntireRow.AutoFit
        
        ' Format data.
        With rg.Resize(rg.Rows.Count - 1).Offset(1)
            ' XXXX in M:
            With .FormatConditions.Add(Type:=xlExpression, _
                    Formula1:="=" & .Cells(1, "M").Address(0) & "=""XXXX""")
                .SetFirstPriority
                .StopIfTrue = False
                With .Interior
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent6
                    .TintAndShade = 0.599963377788629
                End With
            End With
            ' XXXX2 in M:
            With .FormatConditions.Add(Type:=xlExpression, _
                    Formula1:="=" & .Cells(1, "M").Address(0) & "=""XXXX2""")
                .SetFirstPriority
                .StopIfTrue = False
                With .Interior
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent2
                    .TintAndShade = 0.399945066682944
                End With
            End With
            ' XXXX,XXXX2,XXXX3,XXXX4 in K:
            With .FormatConditions.Add(Type:=xlExpression, _
                    Formula1:="=LEFT(" & .Cells(1, "K").Address(0) _
                    & ",4)=""XXXX""")
                .SetFirstPriority
                .StopIfTrue = False
                With .Interior
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent6
                    .TintAndShade = 0.399945066682943
                End With
            End With
            With .Columns("R")
                ' between 200 & 1 in R:
                With .FormatConditions.Add(Type:=xlCellValue, _
                        Operator:=xlBetween, Formula1:="=200", Formula2:="=1")
                    .SetFirstPriority
                    .StopIfTrue = False
                    With .Font
                         .ThemeColor = xlThemeColorDark1
                         .TintAndShade = 0
                    End With
                    With .Interior
                         .PatternColorIndex = xlAutomatic
                         .Color = 192
                         .TintAndShade = 0
                    End With
                End With
                ' EXP in R:
                With .FormatConditions.Add(Type:=xlTextString, String:="EXP", _
                        TextOperator:=xlContains)
                    .SetFirstPriority
                    .StopIfTrue = False
                    With .Font
                        .ThemeColor = xlThemeColorDark1
                        .TintAndShade = 0
                    End With
                    With .Interior
                        .PatternColorIndex = xlAutomatic
                        .Color = 192
                        .TintAndShade = 0
                    End With
                End With
            End With
            ' top 15 oldest cases + Bold in H:
            With .Columns("H").FormatConditions.AddTop10
                .TopBottom = xlTop10Top
                .Rank = 15
                .SetFirstPriority
                .StopIfTrue = False
                With .Font
                    .Bold = True
                    .Italic = False
                    .TintAndShade = 0
                End With
                With .Interior
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent1
                    .TintAndShade = 0.399945066682943
                End With
            End With
        End With
    End With
    
    ' Sort Column H descending.
    With ws.AutoFilter.Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=rg.Columns("H"), SortOn:=xlSortOnValues, _
            Order:=xlDescending, DataOption:=xlSortNormal
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    ' Sort Column H descending (without 'AutoFilter').
    'rg.Sort Key1:=rg.Columns("H"), Order1:=xlDescending, Header:=xlYes

End Sub
最新问题
© www.soinside.com 2019 - 2024. All rights reserved.