對于以下查詢的大資料選擇（1000 單元格）不起作用，但對于小資料選擇有效。Excel 停止作業，除非我按轉義鍵。
Sub TrimReplaceAndUppercase()
For Each cell In Selection
If Not cell.HasFormula Then
cell.Value = UCase(cell.Value)
cell = Trim(cell)
Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End If
Next cell
End Sub
uj5u.com熱心網友回復：
Excel 沒有停止作業。如果 Excel 凍結，則表示 Excel 仍在作業！由于選擇范圍很大，它需要更長的時間，所以看起來它什么也沒做。
我建議使用 VBAreplace()而不是Range.Replace()并在一個步驟中完成所有操作，否則你有 3 個讀/寫操作，這會使速度慢 3 倍。同時關閉螢屏更新和計算，讓它運行得更快。
Option Explicit
Public Sub TrimReplaceAndUppercase()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
On Error GoTo CLEAN_EXIT ' in case anything goes wrong make sure to reactivate calculation and screenupdating
Dim Cell As Range
For Each Cell In Selection.Cells
If Not Cell.HasFormula Then
Cell.Value = Replace$(Trim(UCase(Cell.Value)), "-", vbNullString)
End If
Next Cell
CLEAN_EXIT:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
' If there was an error above we want to know
If Err.Number Then Err.Raise Err.Number
End Sub
問題是這段代碼
cell.Value = UCase(cell.Value)
cell = Trim(cell)
Selection.Replace What:="-", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
意味著讀取單元格內容 3 次，寫入單元格內容 3 次。每個讀/寫操作都需要花費大量時間。并且每個寫操作都會觸發一個需要時間的計算。
因此，首先您要將讀寫操作最小化為僅 1 個操作。從單元格中讀取一次資料，進行所有處理并將其寫回一次。
其次，您不希望對每個寫入操作進行計算，因此我們將其設定為手動，最后設定回自動。這將在最后（對所有更改的單元格）只進行一次計算，而不是對每個單個單元格進行計算。
uj5u.com熱心網友回復：
避免使用Selection. 您可能想看看如何避免在 Excel VBA 中使用 Select
如果您仍想使用Selection，請確保它是一個有效的選擇以最小化錯誤。
這是您可以嘗試的另一件事（未經測驗）
我已經對代碼進行了注釋，因此您理解它應該沒有問題。
Option Explicit
Sub Sample()
Dim rng As Range
Dim aCell As Range
On Error GoTo Whoa
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'~~> Check if what the user selected is a valid range
If TypeName(Selection) <> "Range" Then
MsgBox "Select a range first."
Exit Sub
End If
'~~> Work with only those cells which do not have formula
On Error Resume Next
Set rng = Selection.SpecialCells(xlCellTypeConstants)
On Error GoTo 0
'~~> Check if there are cells which have text
If rng Is Nothing Then
MsgBox "No cells with data found"
Exit Sub
End If
'~~> Replace
rng.Replace What:="-", Replacement:="", LookAt:=xlPart
'~~> Trim and Uppercase in one line
For Each aCell In rng
aCell.Value = Trim(UCase(aCell.Value))
Next aCell
LetsContinue:
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/houduan/535468.html