Диапазон и ActiveCell.Offset Ошибка выполнения «1004»

Я пытаюсь определить минимальное и максимальное значения диапазона из 5 ячеек (C: G) для всех непустых строк на листе и помещать соответствующие результаты в столбцы L и M.

Я получаю сообщение об ошибке времени выполнения «1004». Ошибка, определяемая приложением или объектом.

Sub test()
    ActiveSheet.Range("A1").Select
    ActiveCell.Offset(1, 0).Select
    Do While ActiveCell.Value <> Empty
        ActiveCell.Offset(0, 11) = WorksheetFunction.Min(Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 6)))
        ActiveCell.Offset(0, 12) = WorksheetFunction.Max(Range(ActiveCell.Offset(0, 2), ActiveCell.Offset(0, 6)))
        ActiveCell.Offset(1, 0).Select
    Loop
    ActiveSheet.Range("A1").Select
End Sub

Я почти уверен, что моя проблема в спецификации диапазона, но не уверен, что это такое.

Первый и последний выборы - это просто соглашение, которое я использую.

Второй выбор — пройти мимо строки заголовка.

Третий выбор — увеличить строку.

Если есть более простой способ сделать это, пожалуйста, дайте мне знать.


person user3832719    schedule 12.07.2014    source источник
comment
Как избежать использования операторов Select/Active   -  person Dmitry Pavliv    schedule 12.07.2014


Ответы (2)


Я не могу воспроизвести указанную вами ошибку, ваш код работает как есть.

Тем не менее, есть много способов улучшить этот код.

  1. Избегайте Select (как указано в комментариях)
  2. Объект Application предлагает функции Min и Max, для них не нужно использовать WorksheetFunction.
  3. Лучший подход к ссылкам 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
comment
Крис, ваши предложения сработали хорошо - чем вы за вашу помощь. - person user3832719; 15.07.2014
comment
Крис, ваши предложения сработали хорошо - спасибо за вашу помощь. Ваше внимание к деталям (проверка пустых строк) наводит меня на мысль, что вы какое-то время занимаетесь vba. Можете посоветовать хорошую книгу для начинающих? - person user3832719; 15.07.2014

Как насчет этого?

Sub MinAndMax()
    Dim rng As Range
    Set rng = Range("A2:A" & Range("A2").End(xlDown).Row)

    Range("L1") = WorksheetFunction.Min(rng)
    Range("M1") = WorksheetFunction.Max(rng)
End Sub
  • Определите диапазон заранее
  • Запишите min и max непосредственно в ячейки
person Alex P    schedule 12.07.2014
comment
Алекс, спасибо за ваш ответ. Я ошибся в своем первоначальном вопросе. Я должен был сказать для КАЖДОЙ непустой строки вместо ВСЕХ непустых строк - я хотел создать минимум/максимум для каждой строки. - person user3832719; 15.07.2014