范圍和ActiveCell.Offset運行時錯誤'1004'

Question

我正在嘗試確定工作表中所有非空白行的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

我很確定我的問題出在范圍的說明中，但不確定是什么。

第一個和最后一個選擇只是我使用的約定。

第二個選擇是跨過標題行。

第三個選擇是增加行數。

如果有更簡單的方法，請告訴我。

Answer 1

我無法重現您提到的錯誤，您的代碼似乎按原樣運行。

也就是說，有很多方法可以改善此代碼

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

Answer 2

這個怎么樣？

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直接寫入單元格