选择所有单元格在一次以上限值

Question

我可以在区域包含数字仅选择单元格。例如上述那些1.0

我有一个大数字的工作表，我想盖上1以上的所有数字，并将它们设置为1.我喜欢这样做，而不必在每个单元格上循环。

谢谢！

Answer 1

我说，忘了SpecialCells。只需将需要测试的所有单元格加载到Variant数组中。然后循环播放该数组，并进行上限。这是非常有效的，与在表单中循环单元格相反。最后，将其写回表单。

使用包含介于0和2之间的随机值的50,000个单元格，此代码在我的古董笔记本电脑上以0.2秒运行。

额外的好处是，这是相当清晰和可读的代码，并且您可以完全控制将操作的范围。

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. 

Answer 2

循环的危害是什么？我刚刚在39900个单元格范围内测试了这段代码，并以2秒的速度运行。

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 

我唯一担心的是使用SpecialCells的，因为它们是不可预知的，所以我很少使用它们。

也有看看这个知识库文章：http://support.microsoft.com/?kbid=832293

Answer 3

下面这种方法避免了通过细胞循环的细胞 - 而这是显著长于范围循环代码我同意你的喜好，以避免细胞通过细胞范围循环，其中可能

我已经更新从A fast method for determining the unlocked cell range我的代码，以提供由细胞循环方法的非细胞

1. 代码检查该SpecialCells(xlCellTypeConstants , xlNumbers) 在片材吨存在ø被更新（错误处理应始终使用与SpecialCells
2. 如果这些细胞存在，工作片被创建 ，和式被插入到范围为第1步建立一个故意错误（1/0 ）如果在主片的值是> 1
3. SpecialCells(xlCellTypeFormulas, xlErrors)返回的单元格范围从工作片其中的值均大于1（成rng3）

4. 在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 
       .DisplayAlerts = 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 
       Set rng3 = ws1.Range(rng2.Address) 
   rng3.Value2 = 1  
         Else 
       MsgBox "No constants < 1" 
   End If 
   ws2.Delete 
   
   'cleanup user interface and settings 
   With Application 
       .ScreenUpdating = True 
       .EnableEvents = True 
       .DisplayAlerts = 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