### 选择所有单元格一次超过限制值

#### [英]Select all Cells at once above limit value

I can Select only the Cells with in region that contain numbers: ` Region.SpecialCells(xlCellTypeConstants , xlNumbers)`

but I don't know how to Select only the cells that are above a number. For example those above 1.0

I have a big Sheet with numbers and I want to cap all numbers above 1, and set them to 1. I would love to do it without having to loop on each cell.

thanks!

## 3 个解决方案

### #1

2

I say, forget about `SpecialCells`. Just load all cells that need testing into a Variant array. Then loop over that array and do your capping. That is very efficient, contrary to looping over cells in a sheet. Finally, write it back to the sheet.

With 50,000 cells containing random values between 0 and 2, this code ran in 0.2 s on my antique laptop.

The added bonus is that this is quite clear and readable code, and you retain full control over what range will be operated on.

``````Dim r As Range
Dim v As Variant
Set r = Sheet1.UsedRange
' Or customise it:
'Set r = Sheet1.Range("A1:HZ234") ' or whatever.
v = r ' Load cells to a Variant array

Dim i As Long, j As Long
For i = LBound(v, 1) To UBound(v, 1)
For j = LBound(v, 2) To UBound(v, 2)
If IsNumeric(v(i, j)) And v(i, j) > 1 Then
v(i, j) = 1 ' Cap value to 1.
End If
Next j
Next i

r = v ' Write Variant array back to sheet.
``````

### #2

4

This method below avoids the cell by cell loop - while it is significantly longer than your range loop code I share your preference for avoiding cell by cell range loops where possible

I have updated my code from A fast method for determining the unlocked cell range to provide a non cell by cell loop method

1. the code checks that `SpecialCells(xlCellTypeConstants , xlNumbers)` exist on the sheet to be updated (error handling should always be used with `SpecialCells`
2. 代码检查要更新的工作表上是否存在SpecialCells（xlCellTypeConstants，xlNumbers）（错误处理应始终与SpecialCells一起使用
3. if these cells exist, a working sheet is created, and a formula is inserted into the range from step 1 to create a deliberate error (the 1/0) if the value on the main sheet is >1
4. 如果这些单元格存在，则创建工作表，并且如果主工作表上的值> 1，则将公式插入到步骤1的范围内以创建故意错误（1/0）
5. `SpecialCells(xlCellTypeFormulas, xlErrors)` returns a range of cells from the working sheet where the values were greater than 1 (into `rng3`)
6. SpecialCells（xlCellTypeFormulas，xlErrors）返回工作表中一系列单元格，其值大于1（进入rng3）
7. All areas in `rng3` are set to 1 with `rng3.Value2=1`

rng3中的所有区域都设置为1，rng3.Value2 = 1

``````Sub QuickUpdate()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim lCalc As Long

Set ws1 = ActiveSheet

On Error Resume Next
Set rng1 = ws1.Cells.SpecialCells(xlConstants, xlNumbers)
On Error GoTo 0
'exit if there are no contants with numbers
If rng1 Is Nothing Then Exit Sub

'disable screenupdating, event code and warning messages.
'set calculation to manual
With Application
.ScreenUpdating = False
.EnableEvents = False
lCalc = .Calculation
.Calculation = xlCalculationManual
End With

ws1.Copy After:=Sheets(Sheets.Count)
Set ws2 = ActiveSheet
'test for cells constants > 1
ws2.Cells.SpecialCells(xlConstants, xlNumbers).FormulaR1C1 = "=IF('" & ws1.Name & "'!RC>1,1/0,'" & ws1.Name & "'!RC)"
On Error Resume Next
Set rng2 = ws2.Cells.SpecialCells(xlCellTypeFormulas, xlErrors)
On Error GoTo 0

If Not rng2 Is Nothing Then
rng3.Value2 = 1
Else
MsgBox "No constants < 1"
End If
ws2.Delete

'cleanup user interface and settings
With Application
.ScreenUpdating = True
.EnableEvents = True
lCalc = .Calculation
End With

'inform the user of the unlocked cell range
If Not rng3 Is Nothing Then
MsgBox "Cells updated in Sheet " & vbNewLine & ws1.Name & vbNewLine & " are " & vbNewLine & rng3.Address(0, 0)
Else
MsgBox "No cells updated in " & ws1.Name
End If
End Sub
``````

### #3

2

What is the harm in looping? I just tested this code on a range of 39900 cells and it ran in 2 Secs.

``````Sub Sample()
Dim Rng As Range, aCell As Range

Set Rng = Cells.SpecialCells(xlCellTypeConstants, xlNumbers)

For Each aCell In Rng
If aCell.Value > 1 Then aCell.Value = 1
Next aCell
End Sub
``````

My only concern is the use of SpecialCells as they are unpredictable and hence I rarely use them.

Also have a look at this KB article: http://support.microsoft.com/?kbid=832293