Я не могу воспроизвести указанную вами ошибку, ваш код работает как есть.
Тем не менее, есть много способов улучшить этот код.
- Избегайте
Select
(как указано в комментариях)
- Объект
Application
предлагает функции Min
и Max
, для них не нужно использовать WorksheetFunction
.
- Лучший подход к ссылкам
range
— это комбинация Offset
и Resize
.
Ваш код, реорганизованный для использования этих методов
Sub Demo()
Dim ws As Worksheet
Dim rng As Range
Dim rw As Range
' Get a reference to the source data range
Set ws = ActiveSheet
With ws
Set rng = .Cells(2, 1)
' Just in case there is only one data row
If Not IsEmpty(rng.Offset(1, 0)) Then
Set rng = .Range(rng, rng.End(xlDown))
End If
End With
' Loop the range
For Each rw In rng.Rows
rw.Offset(0, 11) = Application.Min(rw.Offset(0, 1).Resize(, 5))
rw.Offset(0, 12) = Application.Max(rw.Offset(0, 1).Resize(, 5))
Next
End Sub
Тем не менее, вы можете пойти дальше и использовать подход Variant Array
. Это работает намного быстрее, чем зацикливание диапазона (воздействие будет зависеть от количества строк данных).
Sub Demo2()
Dim ws As Worksheet
Dim rng As Range
Dim dat As Variant
Dim res As Variant
Dim i As Long
' Get a reference to the source data range
Set ws = ActiveSheet
With ws
Set rng = .Cells(2, 1)
' Just in case there is only one data row
If Not IsEmpty(rng.Offset(1, 0)) Then
Set rng = .Range(rng, rng.End(xlDown))
End If
End With
' Set up source and result arrays
dat = rng.Offset(, 2).Resize(, 5).Value
ReDim res(1 To UBound(dat, 1), 1 To 2)
With Application
' Loop the array
For i = 1 To UBound(dat, 1)
res(i, 1) = .Min(.Index(dat, i))
res(i, 2) = .Max(.Index(dat, i))
Next
End With
' Return results to sheet
rng.Offset(0, 11).Resize(, 2) = res
End Sub
Другой метод состоит в том, чтобы полностью избежать цикла, (временно) помещая формулу на лист за один раз. Это будет намного еще быстрее (для более чем нескольких строк данных).
Sub Demo3()
Dim ws As Worksheet
Dim rng As Range
Dim rw As Range
' Get a reference to the source data range
Set ws = ActiveSheet
With ws
Set rng = .Cells(2, 1)
If Not IsEmpty(rng.Offset(1, 0)) Then
Set rng = .Range(rng, rng.End(xlDown))
End If
End With
' Place formulas into sheet
rng.Offset(0, 11).FormulaR1C1 = "=Min(RC[-9]:RC[-5])"
rng.Offset(0, 12).FormulaR1C1 = "=Max(RC[-9]:RC[-5])"
' replace formulas with values (optional)
rng.Value = rng.Value
End Sub
person
chris neilsen
schedule
12.07.2014