限界値

Question

上、一度すべてのセルを選択私は数字が含まれている地域の持つ細胞のみを選択することができます Region.SpecialCells(xlCellTypeConstants , xlNumbers)

を私は数を超えている細胞のみを選択する方法がわかりません。例えば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 

私は唯一懸念しているのは、予測できないスペシャルセルの使用であり、ほとんど使用しません。 - それはあなたの範囲のループコードよりもかなり長い間、私はどこループセル範囲でセルを避けるために、あなたの好みを共有http://support.microsoft.com/?kbid=832293

Answer 3

この方法は、以下の細胞ループによってセルは避け：

はまた、このKBの記事を見て可能

私は、セルのループ方式による非電池を提供することにA fast method for determining the unlocked cell rangeから自分のコードを更新しました

1. コードがSpecialCells(xlCellTypeConstants , xlNumbers) は、シートT上に存在することを確認しますO更新する（エラーハンドリングが常に 、これらの細胞が存在する場合、ワーキングシートが作成され、そして式が意図的エラーを作成するために、ステップ1の範囲に挿入されるSpecialCells
2. と共に使用されるべきである（1/0 ）メインシート上の値が> 1
3. SpecialCells(xlCellTypeFormulas, xlErrors)がrng3に値が1より大きかった作業シート（からの細胞の範囲を返している場合）

4. rng3のすべての領域がrng3.Value2=1

   で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