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

Question

I have a sheet that is used for sales entry, that has 15 different columns that get formatted based on what is entered in the cell. It's simple formatting, converting to proper case, things like that.

The shortened version of the code is:

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..

The reason I have it set to manual, then automatic, is because if I don't, Excel crawls to a halt. I'm assuming because when a user enters data, it changes values for hidden columns, and triggers the Change event again. The way it works now, is fine, however there is just a second or two delay after each cell is checked and formatted after a user enters the data, so ultimately I'm wondering if there is a quicker way to do it.

Thanks!

Answer 1

One obvious issues:

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

should be

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

Try this:

---

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

---

Notes:

• turning Off and On Application.ScreenUpdating takes longer than updating the cell
• String versions (Trim$) are significantly faster ~ approx 10-30%..." , and so is UCase$()

Answer 2

Try your intersect as,

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

The worksheet's .UsedRange property is decided beforehand. If you made an entry outside the usedrange, the usedrange would instantly expand to encompass it. This known as 'overhead' and it's one of the reasons that vba is slower than C or hex.

After you've determined that one or more cells in target is involved with something you want to do, parse each cell in target to determine how it should be processed.

Answer 3

you may try this:

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