首页
学习
活动
专区
圈层
工具
发布
首页
学习
活动
专区
圈层
工具
MCP广场
社区首页 >问答首页 >有没有办法加快格式化成千上万行的速度?

有没有办法加快格式化成千上万行的速度?
EN

Stack Overflow用户
提问于 2022-04-19 16:22:40
回答 3查看 102关注 0票数 2

我已经做了下面的代码,它消除了for循环的需要,但它仍然冻结Excel。这段代码本质上将用边框、数字格式等对8行进行格式化。我需要加快速度,因为我正在与我编写的另一个宏一起运行,这个宏在合理的时间内工作,但是添加这个格式会造成一些混乱。

代码语言:javascript
运行
复制
Sub Format()
'Borders
Range("A2:F9,G2:I3,G4:I5,G6:I7,G8:I9,J2:V3,J4:V5,J6:V7,J8:V9,W2:W9,X2:AI3,X4:AI5,X6:AI7,X8:AI9,AJ2:AJ9").Select
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With

'Format percentages
Range("X3:AI3,X5:AI5,X7:AI7,X9:AI9").Select
Selection.NumberFormat = "0.00%"

Range("F:F,J2:W" & endRow).Select
Selection.NumberFormat = "0"

Range("J1:V1").Select
Selection.NumberFormat = "mmm-yy"

Range("X1:AI1").Select
Selection.NumberFormat = "mmm"

'Text Alignment
Range("A:A,C:C,D:D,F:AJ").Select
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .ReadingOrder = xlContext
End With

Range("A2:AJ9").Copy
Range("A2:AJ" & endRow).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

Range("A1,C1,D1,F1:I1,W1,AJ1").EntireColumn.AutoFit
Range("B1").ColumnWidth = 32
Range("E1").ColumnWidth = 40
Range("J1:V1,X1:AI1").ColumnWidth = 7.5
End Sub

变量endRow是在其他地方确定的,因为这个宏在另一个宏中调用。为了简单起见,让我们假设endRow = 80,002 (头部的额外2个帐户)。

编辑1:

为了澄清,有一个标题行,然后要格式化的数据如下所示。这段代码的几行代码修改了标题数据,因此下面的代码没有对标题进行格式化以明确问题。

代码语言:javascript
运行
复制
Sub Format()
'Borders
Range("A2:F9,G2:I3,G4:I5,G6:I7,G8:I9,J2:V3,J4:V5,J6:V7,J8:V9,W2:W9,X2:AI3,X4:AI5,X6:AI7,X8:AI9,AJ2:AJ9").Select
With Selection.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With

'Format percentages
Range("X3:AI3,X5:AI5,X7:AI7,X9:AI9").Select
Selection.NumberFormat = "0.00%"

Range("F:F,J2:W" & endRow).Select
Selection.NumberFormat = "0"

'Text Alignment
Range("A:A,C:C,D:D,F:AJ").Select
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .ReadingOrder = xlContext
End With

Range("A2:AJ9").Copy
Range("A2:AJ" & endRow).Select
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False

Range("A1,C1,D1,F1:I1,W1,AJ1").EntireColumn.AutoFit
Range("B1").ColumnWidth = 32
Range("E1").ColumnWidth = 40
Range("J1:V1,X1:AI1").ColumnWidth = 7.5
End Sub

编辑2:

我试了提姆威廉姆斯的建议,但这只会导致所有的细胞都有我不想要的所有边框。

编辑3:

这篇文章越来越长了,但我想这是我认为可以进一步优化的东西,但我不确定如何实现。

代码语言:javascript
运行
复制
Sub Format()
Dim rng As Range
Set rng = Sht.Range("A2:F9,G2:I3,G4:I5,G6:I7,G8:I9,J2:V3,J4:V5,J6:V7,J8:V9,W2:W9,X2:AI3,X4:AI5,X6:AI7,X8:AI9,AJ2:AJ9")
'Borders
With rng.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With rng.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With rng.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With rng.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With

'Format percentages
Range("X3:AI3,X5:AI5,X7:AI7,X9:AI9").NumberFormat = "0.00%"

Range("F:F,J2:W" & endRow).NumberFormat = "0"

Range("J1:V1").NumberFormat = "mmm-yy"

Range("X1:AI1").NumberFormat = "mmm"

'Text Alignment
With Range("A:A,C:C,D:D,F:AJ")
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .ReadingOrder = xlContext
End With

Range("A2:AJ9").Copy
Range("A2:AJ" & endRow).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Range("A1,C1,D1,F1:I1,W1,AJ1").EntireColumn.AutoFit
Range("B1").ColumnWidth = 32
Range("E1").ColumnWidth = 40
Range("J1:V1,X1:AI1").ColumnWidth = 7.5
End Sub
EN

回答 3

Stack Overflow用户

回答已采纳

发布于 2022-04-21 21:29:25

我在这个帖子中找到了一个灵感来自于许多评论和其他答案的解决方案。我希望它能帮助更多的观众了解这条线索。

代码语言:javascript
运行
复制
Private Sub Format()
Dim rng As Range
Set rng = Sht.Range("A2:F9,G2:I3,G4:I5,G6:I7,G8:I9,J2:V3,J4:V5,J6:V7,J8:V9,W2:W9,X2:AI3,X4:AI5,X6:AI7,X8:AI9,AJ2:AJ9")
With Sht
'Borders
With rng.Borders(xlEdgeLeft)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With rng.Borders(xlEdgeTop)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With rng.Borders(xlEdgeBottom)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With
With rng.Borders(xlEdgeRight)
    .LineStyle = xlContinuous
    .Weight = xlMedium
End With

'Format percentages
.Range("X3:AI3,X5:AI5,X7:AI7,X9:AI9").NumberFormat = "0.00%"

.Range("F:F,J2:W" & endRow).NumberFormat = "0"

.Range("J1:V1").NumberFormat = "mmm-yy"

.Range("X1:AI1").NumberFormat = "mmm"

'Text Alignment
With .Range("A:A,C:C,D:D,F:AJ")
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlBottom
    .ReadingOrder = xlContext
End With

.Range("A2:AJ9").Copy
.Range("A2:AJ" & endRow).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

.Range("A1,C1,D1,F1:I1,W1,AJ1").EntireColumn.AutoFit
.Range("B1").ColumnWidth = 32
.Range("E1").ColumnWidth = 40
.Range("J1:V1,X1:AI1").ColumnWidth = 7.5
End With
End Sub

这其中大部分是非常具体的,虽然我的情况,所以这可能不是对别人最有帮助,但我离题。

票数 0
EN

Stack Overflow用户

发布于 2022-04-19 17:41:38

格式化千行

代码语言:javascript
运行
复制
Sub Format()
    
    Const EndRow As Long = 80001
    
    Application.ScreenUpdating = False
    
    With ActiveSheet ' improve!
        
        ' Borders
        With .Range("A2:F9,G2:I3,G4:I5,G6:I7,G8:I9,J2:V3,J4:V5," _
                & "J6:V7,J8:V9,W2:W9,X2:AI3,X4:AI5,X6:AI7,X8:AI9,AJ2:AJ9")
            With .Borders(xlEdgeLeft)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
            With .Borders(xlEdgeTop)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
            With .Borders(xlEdgeBottom)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
            With .Borders(xlEdgeRight)
                .LineStyle = xlContinuous
                .Weight = xlMedium
            End With
        End With
        
        ' Number Formats
        .Range("X3:AI3,X5:AI5,X7:AI7,X9:AI9").NumberFormat = "0.00%"
        .Range("F1:F9,J2:W9").NumberFormat = "0"
        .Range("J1:V1").NumberFormat = "mmm-yy"
        .Range("X1:AI1").NumberFormat = "mmm"
    
        ' Text Alignment
        With .Range("A1:A9,C1:C9,D1:D9,F1:AJ9")
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .ReadingOrder = xlContext
        End With
        
        ' Copy Down Formats
        .Range("A2:AJ9").Copy
        .Range("A2:AJ" & EndRow).PasteSpecial Paste:=xlPasteFormats
        
        ' Column Widths
        .Range("A1,C1,D1,F1:I1,W1,AJ1").EntireColumn.AutoFit
        .Range("B1").ColumnWidth = 32
        .Range("E1").ColumnWidth = 40
        .Range("J1:V1,X1:AI1").ColumnWidth = 7.5
    
    End With
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
End Sub

Argumented

  • 通过添加工作表参数重写了以前的子部分.

代码语言:javascript
运行
复制
Sub FormatSheet(ByVal ws As Worksheet)

    Const EndRow As Long = 80001

    Application.ScreenUpdating = False

    With ws
    

    End With

    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

  • 最后,从另一艘潜艇

调用潜艇。

代码语言:javascript
运行
复制
Sub Test()

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    FormatSheet ws

End Sub

  • 类似地,您可以添加EndRow参数..。

子FormatSheet2(ByVal ws作为工作表,ByVal EndRow As Long)

并用例如:

FormatSheet2 ws,80001

票数 3
EN

Stack Overflow用户

发布于 2022-04-20 20:13:12

创建2个新的类模块,并以您想要的任何名称调用它们,为了解释起见,让我们将它们称为SettingClass1和SettingClass2。

在SettingClass1上编写以下代码:

代码语言:javascript
运行
复制
Option Explicit

Private calculation As XlCalculation
Private displayStatus As Boolean
Private enableEvents As Boolean
Private screenUpdating As Boolean

Public Sub Backup()

calculation = Application.calculation
displayStatus = Application.DisplayStatusBar
enableEvents = Application.enableEvents
screenUpdating = Application.screenUpdating

End Sub

Public Sub Restore()

Application.calculation = calculation
Application.DisplayStatusBar = displayStatus
Application.enableEvents = enableEvents
Application.screenUpdating = screenUpdating
 
End Sub

Public Sub TurnOff()

Call Backup

Application.calculation = xlCalculationManual
Application.DisplayStatusBar = False
Application.enableEvents = False
Application.screenUpdating = False

End Sub

Public Sub TurnOn()

Application.calculation = xlCalculationAutomatic
Application.DisplayStatusBar = True
Application.enableEvents = True
Application.screenUpdating = True

End Sub

之后,在SettingClass2上编写以下代码:

代码语言:javascript
运行
复制
Option Explicit

Private Interactive As Boolean
Private DisplayAlerts As Boolean
Private AskUpdateLinks As Boolean

Public Sub Backup()

Interactive = Application.Interactive
DisplayAlerts = Application.DisplayAlerts
AskUpdateLinks = Application.AskToUpdateLinks

End Sub

Public Sub Restore()

Application.Interactive = Interactive
Application.DisplayAlerts = DisplayAlerts
Application.AskToUpdateLinks = AskUpdateLinks
 
End Sub

Public Sub TurnOff()

Call Backup

Application.Interactive = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False

End Sub

Public Sub TurnOn()

Application.Interactive = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True

End Sub

之后,通过添加以下内容编辑代码:

代码语言:javascript
运行
复制
Sub Format()

Dim settings As New SettingClass1
Dim settingsAlerts As New SettingClass2

settings.TurnOff
settingsAlerts.TurnOff

'Borders

然后在代码末尾添加:

代码语言:javascript
运行
复制
Range("J1:V1,X1:AI1").ColumnWidth = 7.5

settings.TurnOn
settingsAlerts.TurnOn

End Sub

我注意到,在您的代码中,sht没有在任何地方声明或设置,也没有设置endRow。

因此,我编写了代码,将sht声明为工作表,endRow声明为Long,但是您需要设置sht并为endRow分配一个值。

您还可以通过这样修改代码来进一步优化代码:

代码语言:javascript
运行
复制
Sub Format()

Dim settings As New SettingClass1
Dim settingsAlerts As New SettingClass2

settings.TurnOff
settingsAlerts.TurnOff

Dim rng As Range
Dim area As Variant
Dim sht As Worksheet
Dim endRow as Long

'Code here to set the worksheet sht
'Set sht = '''whatever you need to write here to set the worksheet
'Code here to assign a value to endRow
'endRow = '''whatever you need to write here to assign the appropiate value to endRow

Set rng = sht.Range("A2:F9,G2:I3,G4:I5,G6:I7,G8:I9,J2:V3,J4:V5,J6:V7,J8:V9,W2:W9,X2:AI3,X4:AI5,X6:AI7,X8:AI9,AJ2:AJ9")
'Borders

For Each area In rng.areas
    
    With area
        With .Borders(xlEdgeLeft)
            .LineStyle = xlContinuous
            .Weight = xlMedium
        End With
        With .Borders(xlEdgeTop)
            .LineStyle = xlContinuous
            .Weight = xlMedium
        End With
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .Weight = xlMedium
        End With
        With .Borders(xlEdgeRight)
            .LineStyle = xlContinuous
            .Weight = xlMedium
        End With
    End With

Next area

'Format percentages
With sht
    
    Set rng = .Range("X3:AI3,X5:AI5,X7:AI7,X9:AI9")
    
    For Each area In rng.areas
        
        With area
            
            .NumberFormat = "0.00%"
            
        End With
        
    Next area
    
    Set rng = .Range("F:F,J2:W" & endRow)
    
    For Each area In rng.areas
        
        With area
            
            .NumberFormat = "0"
            
        End With
        
    Next area
    
    
    .Range("J1:V1").NumberFormat = "mmm-yy"
    
    .Range("X1:AI1").NumberFormat = "mmm"
    
    'Text Alignment
    
    Set rng = .Range("A:A,C:C,D:D,F:AJ")
    
    For Each area In rng.areas
        
        With area
            
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .ReadingOrder = xlContext
            
        End With
        
    Next area
    
    .Range("A2:AJ9").Copy
    .Range("A2:AJ" & endRow).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    Set rng = .Range("A1,C1,D1,F1:I1,W1,AJ1")
    
    For Each area In rng.areas
        
        With area
            
            .EntireColumn.AutoFit
            
        End With
        
    Next area
    
    .Range("B1").ColumnWidth = 32
    .Range("E1").ColumnWidth = 40
    
    Set rng = .Range("J1:V1,X1:AI1")
    
    For Each area In rng.areas
        
        With area
            
            .ColumnWidth = 7.5
            
        End With
        
    Next area
    
End With

settings.TurnOn
settingsAlerts.TurnOn

End Sub

告诉我这对你来说是怎么回事。

更新:

您可以使用以下函数调用函数和子函数,请仔细选择是否需要运行sub、返回可以存储在变量中的变量或需要存储在对象上的变量。

可选参数只能是变量,而不是对象,因此不能将工作表作为参数传递。

wbk应该设置为要运行的宏所在的工作簿,MacroName应该是要运行的函数/子函数的名称。

如果工作簿位于OneDrive上,它将无法工作,如果是这样的话,我可以修改提供的函数来工作,如果工作簿位于OneDrive上的话。

代码语言:javascript
运行
复制
Public Function RunFunctionObject(wbk As Workbook, MacroName As String, Optional Arg1 As Variant = "", _
    Optional Arg2 As Variant = "", Optional Arg3 As Variant = "", Optional Arg4 As Variant = "", Optional Arg5 As Variant = "", _
    Optional Arg6 As Variant = "", Optional Arg7 As Variant = "", Optional Arg8 As Variant = "", Optional Arg9 As Variant = "", _
    Optional Arg10 As Variant = "", Optional Arg11 As Variant = "", Optional Arg12 As Variant = "", Optional Arg13 As Variant = "", _
    Optional Arg14 As Variant = "", Optional Arg15 As Variant = "", Optional Arg16 As Variant = "", Optional Arg17 As Variant = "", _
    Optional Arg18 As Variant = "", Optional Arg19 As Variant = "", Optional Arg20 As Variant = "", Optional Arg21 As Variant = "", _
    Optional Arg22 As Variant = "", Optional Arg23 As Variant = "", Optional Arg24 As Variant = "", Optional Arg25 As Variant = "", _
    Optional Arg26 As Variant = "", Optional Arg27 As Variant = "", Optional Arg28 As Variant = "", Optional Arg29 As Variant = "", _
    Optional Arg30 As Variant = "") As Object

'RunFunctionObject executes the function named MacroName which is found on the workbook Wbk _
' and returns the functions RETURN object

Dim MacroString As String

MacroString = "'" & wbk.Path & Application.PathSeparator & wbk.name & "'!" & MacroName

If Arg1 = "" Then
    Set RunFunctionObject = Application.Run(MacroString)
ElseIf Arg2 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1)
ElseIf Arg3 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2)
ElseIf Arg4 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3)
ElseIf Arg5 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4)
ElseIf Arg6 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg5)
ElseIf Arg7 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6)
ElseIf Arg8 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7)
ElseIf Arg9 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8)
ElseIf Arg10 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9)
ElseIf Arg11 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10)
ElseIf Arg12 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11)
ElseIf Arg13 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12)
ElseIf Arg14 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13)
ElseIf Arg15 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14)
ElseIf Arg16 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15)
ElseIf Arg17 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16)
ElseIf Arg18 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17)
ElseIf Arg19 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18)
ElseIf Arg20 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19)
ElseIf Arg21 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20)
ElseIf Arg22 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21)
ElseIf Arg23 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22)
ElseIf Arg24 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23)
ElseIf Arg25 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24)
ElseIf Arg26 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25)
ElseIf Arg27 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26)
ElseIf Arg28 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27)
ElseIf Arg29 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28)
ElseIf Arg30 = "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29)
ElseIf Arg30 <> "" Then
    Set RunFunctionObject = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30)
End If

End Function

Public Function RunFunctionVariant(wbk As Workbook, MacroName As String, Optional Arg1 As Variant = "", _
    Optional Arg2 As Variant = "", Optional Arg3 As Variant = "", Optional Arg4 As Variant = "", Optional Arg5 As Variant = "", _
    Optional Arg6 As Variant = "", Optional Arg7 As Variant = "", Optional Arg8 As Variant = "", Optional Arg9 As Variant = "", _
    Optional Arg10 As Variant = "", Optional Arg11 As Variant = "", Optional Arg12 As Variant = "", Optional Arg13 As Variant = "", _
    Optional Arg14 As Variant = "", Optional Arg15 As Variant = "", Optional Arg16 As Variant = "", Optional Arg17 As Variant = "", _
    Optional Arg18 As Variant = "", Optional Arg19 As Variant = "", Optional Arg20 As Variant = "", Optional Arg21 As Variant = "", _
    Optional Arg22 As Variant = "", Optional Arg23 As Variant = "", Optional Arg24 As Variant = "", Optional Arg25 As Variant = "", _
    Optional Arg26 As Variant = "", Optional Arg27 As Variant = "", Optional Arg28 As Variant = "", Optional Arg29 As Variant = "", _
    Optional Arg30 As Variant = "") As Variant

'RunFunctionVariant executes the function named MacroName which is found on the workbook Wbk _
' and returns the functions RETURN variable

Dim MacroString As String

MacroString = "'" & wbk.Path & Application.PathSeparator & wbk.name & "'!" & MacroName

If Arg1 = "" Then
    RunFunctionVariant = Application.Run(MacroString)
ElseIf Arg2 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1)
ElseIf Arg3 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2)
ElseIf Arg4 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3)
ElseIf Arg5 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4)
ElseIf Arg6 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg5)
ElseIf Arg7 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6)
ElseIf Arg8 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7)
ElseIf Arg9 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8)
ElseIf Arg10 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9)
ElseIf Arg11 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10)
ElseIf Arg12 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11)
ElseIf Arg13 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12)
ElseIf Arg14 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13)
ElseIf Arg15 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14)
ElseIf Arg16 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15)
ElseIf Arg17 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16)
ElseIf Arg18 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17)
ElseIf Arg19 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18)
ElseIf Arg20 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19)
ElseIf Arg21 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20)
ElseIf Arg22 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21)
ElseIf Arg23 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22)
ElseIf Arg24 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23)
ElseIf Arg25 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24)
ElseIf Arg26 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25)
ElseIf Arg27 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26)
ElseIf Arg28 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27)
ElseIf Arg29 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28)
ElseIf Arg30 = "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29)
ElseIf Arg30 <> "" Then
    RunFunctionVariant = Application.Run(MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30)
End If

End Function

Public Sub RunSub(wbk As Workbook, MacroName As String, Optional Arg1 As Variant = "", _
    Optional Arg2 As Variant = "", Optional Arg3 As Variant = "", Optional Arg4 As Variant = "", Optional Arg5 As Variant = "", _
    Optional Arg6 As Variant = "", Optional Arg7 As Variant = "", Optional Arg8 As Variant = "", Optional Arg9 As Variant = "", _
    Optional Arg10 As Variant = "", Optional Arg11 As Variant = "", Optional Arg12 As Variant = "", Optional Arg13 As Variant = "", _
    Optional Arg14 As Variant = "", Optional Arg15 As Variant = "", Optional Arg16 As Variant = "", Optional Arg17 As Variant = "", _
    Optional Arg18 As Variant = "", Optional Arg19 As Variant = "", Optional Arg20 As Variant = "", Optional Arg21 As Variant = "", _
    Optional Arg22 As Variant = "", Optional Arg23 As Variant = "", Optional Arg24 As Variant = "", Optional Arg25 As Variant = "", _
    Optional Arg26 As Variant = "", Optional Arg27 As Variant = "", Optional Arg28 As Variant = "", Optional Arg29 As Variant = "", _
    Optional Arg30 As Variant = "")

'RunSub executes the sub named MacroName which is found on the workbook Wbk

Dim MacroString As String

MacroString = "'" & wbk.Path & Application.PathSeparator & wbk.name & "'!" & MacroName

If Arg1 = "" Then
    Application.Run MacroString
ElseIf Arg2 = "" Then
    Application.Run MacroString, Arg1
ElseIf Arg3 = "" Then
    Application.Run MacroString, Arg1, Arg2
ElseIf Arg4 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3
ElseIf Arg5 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4
ElseIf Arg6 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg5
ElseIf Arg7 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6
ElseIf Arg8 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7
ElseIf Arg9 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8
ElseIf Arg10 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9
ElseIf Arg11 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10
ElseIf Arg12 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11
ElseIf Arg13 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12
ElseIf Arg14 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13
ElseIf Arg15 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14
ElseIf Arg16 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15
ElseIf Arg17 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16
ElseIf Arg18 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17
ElseIf Arg19 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18
ElseIf Arg20 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19
ElseIf Arg21 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20
ElseIf Arg22 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21
ElseIf Arg23 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22
ElseIf Arg24 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23
ElseIf Arg25 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24
ElseIf Arg26 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25
ElseIf Arg27 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26
ElseIf Arg28 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27
ElseIf Arg29 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28
ElseIf Arg30 = "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29
ElseIf Arg30 <> "" Then
    Application.Run MacroString, Arg1, Arg2, Arg3, Arg4, Arg6, Arg7, Arg8, Arg9, _
        Arg10, Arg11, Arg12, Arg13, Arg14, Arg15, Arg16, Arg17, Arg18, Arg19, _
        Arg20, Arg21, Arg22, Arg23, Arg24, Arg25, Arg26, Arg27, Arg28, Arg29, Arg30
End If

End Sub

重要!!:

如果在总体代码中将sreenupdating转换为false,然后返回为true,则应该在总体代码上声明和定义设置和settingsAlerts,而不是像我在这里所做的那样在Format()子程序中这样做。

关闭设置和settingsAlerts将极大地加快您的代码速度。

此外,通过像我使用For每个循环那样分别处理每个不同的区域,代码的速度得到了极大的提高。

使用With语句也有助于加快代码的速度,因为编译器需要解释更少的代码。

我希望所有这些都是信息丰富,对你有帮助。

告诉我这会是怎么回事。

票数 0
EN
页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接:

https://stackoverflow.com/questions/71928209

复制
相关文章

相似问题

领券
问题归档专栏文章快讯文章归档关键词归档开发者手册归档开发者手册 Section 归档