Выберите все ячейки одновременно выше предельного значения

Question

Я могу выбрать только те ячейки в регионе, которые содержат числа: Region.SpecialCells(xlCellTypeConstants , xlNumbers)

но я не знаю, как выбрать только те ячейки, которые находятся над числом. Например, те, что выше 1,0

У меня есть большой лист с числами, и я хочу ограничить все числа выше 1 и установить их на 1. Я хотел бы сделать это без необходимости зацикливаться на каждой ячейке.

спасибо!

Answer 1

Этот метод, приведенный ниже, позволяет избежать цикла «ячейка за ячейкой» - хотя он значительно длиннее, чем ваш код цикла диапазона, я разделяю ваше предпочтение избегать циклов ячейка за ячейкой, где это возможно.* Быстрый метод определения диапазона незаблокированных ячеек , чтобы обеспечить метод неячейка за ячейкой

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
   

Answer 2

говорю, забудь про SpecialCells. Просто загрузите все ячейки, которые необходимо протестировать, в массив Variant. Затем зациклите этот массив и сделайте свое ограничение. Это очень эффективно, в отличие от зацикливания на ячейках листа. Наконец, запишите его обратно на лист.

С 50 000 ячеек, содержащих случайные значения от 0 до 2, этот код выполнялся за 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 3

Какой вред в петлеобразовании?Я только что проверил этот код на диапазоне 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