Question

我有一张用于销售条目的工作表，它有15个不同的列，根据在单元格中输入的内容进行格式化。它是简单的格式化，转换为适当的情况，类似的东西。

缩短版的代码是：

Private Sub Worksheet_Change(ByVal target As Range)
On Error GoTo Cleanup
Application.EnableEvents = False: Application.ScreenUpdating = False: 
Application.Calculation = xlCalculationManual ' etc..

Dim rName As String
If Not (Application.Intersect(target, Range("C2:C" & Me.Cells(Me.Rows.Count,"C").End(xlDown).Row)) Is Nothing) Then
    rName = target.Value2
    target.Value2 = UCase(Trim(rName))
End If

14x more above the above (1 each column)

Cleanup:
Application.EnableEvents = True: Application.ScreenUpdating = True: 
Application.Calculation = xlCalculationAutomatic ' etc..

我把它设置为手动，然后是自动的原因是因为如果我不这样做，Excel就会停止运行。我假设因为当用户输入数据时，它会更改隐藏列的值，并再次触发Change事件。它现在的工作方式很好，但是在用户输入数据后检查并格式化每个单元格后只有一两秒或两个延迟，所以最后我想知道是否有更快的方法来执行此操作。

谢谢！

Answer 1

一个明显的问题：

Me.Cells(Me.Rows.Count,"C").End(的 xlDown ).Row 'returns row 1,048,576

应该是

Me.Cells(Me.Rows.Count,"C").End(的 xlUp ).Row

试试这个：

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) If Target.CountLarge = 1 Then If Not (Application.Intersect(Target, Me.UsedRange.Columns("C")) Is Nothing) Then Application.EnableEvents = False Application.Calculation = xlCalculationManual ' etc.. On Error Resume Next Target.Value2 = UCase$(Trim$(Target.Value2)) On Error GoTo 0 Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic ' etc.. End If End If End Sub

注意：

关闭并打开Application.ScreenUpdating需要比更新单元格更长的时间

String versions (Trim$) are significantly faster ~ approx 10-30%..."和so is UCase$()

Answer 2

尝试你的交叉，

If Not Application.Intersect(target, target.parent.usedrange) Is Nothing Then

预先确定工作表的.UsedRange属性。如果您在usedrange之外创建了一个条目，则usedrange会立即扩展以包含它。这称为“开销”，这是vba比C或十六进制慢的原因之一。

在您确定目标中的一个或多个单元格涉及您想要执行的操作后，解析目标中的每个单元格以确定应如何处理它。

Answer 3

你可以试试这个：

Private Sub Worksheet_Change(ByVal target As Range)
    If Intersect(target, Columns("C:Q")) Is Nothing Then Exit Sub ' exit if changed cells are completely outside relevant columns (change "C:Q" to your actual relevant columns indexes)

    Application.EnableEvents = False: Application.ScreenUpdating = False:
    Application.Calculation = xlCalculationManual ' etc..
    On Error GoTo Cleanup

    With Intersect(target, Intersect(UsedRange, Columns("C:Q"))) 'consider only changed cells in relevant columns (change "C:Q" to your actual relevant columns indexes)
        .Value2 = UCase(Trim(.Value2))
    End With

Cleanup:
    Application.EnableEvents = True: Application.ScreenUpdating = True:
    Application.Calculation = xlCalculationAutomatic ' etc..
End Sub

Excel VBA单元格格式，如果是Statemets

3 个答案: