選擇所有單元格在一次以上限值

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