如何在我自己的类中复制Range.Cells的功能?

时间:2011-09-07 13:31:03

标签: excel vba excel-vba

我试图模仿我自己班级中的Range.Cells(row, col)属性。我的.Cells属性确实正确更新了指定的单元格。

然而,问题在于,当我输入d.Cells(1, 3) =时,在等号智能感知之后会建议"Cells(row As Long, col) as Range"。我不确定这是否会给我带来问题。

Cells属性的定义如下:

Property Get Cells(row As Long, col As Variant) As Range

    ' Get the column number for the requested cell
        Dim c As Long
        If IsNumeric(col) Then
            ' ensure it is an int
                c = CInt(col)
        ElseIf VarType(col) = vbString Then
            ' Get column number from the header name
                c = Me.Column(CStr(col))
        Else
            ' Otherwise, variant type is not supported
                Exit Property
        End If

    ' Return the requested Cell if column number is valid
        If c > 0 And c <= pHeaderRange.Columns.Count Then
            Set Cells = pHeaderRange.CurrentRegion.Cells(1 + row, c)
            ' the row is +1 because pHeaderRange.CurrentRegion also returns 
            ' the header row
        End If

End Property

我也试过这个:

Public Property Get Cells(row As Long, col As Variant) As Range
    ' same code as above
End Property
Public Property Set Cells(v As Variant)
    ' some code here
End Property

但是我收到消息:“编译错误:同一属性的属性过程的定义不一致,或者属性过程有一个可选参数ParamArray,或者无效的Set final参数。”

我认为由于我在此行Property Get Cells(row As Long, col As Variant) As Range中包含的参数而导致编译错误。但我需要这些参数来选择单元格。

在用户定义的类中定义.Cells属性的正确方法是什么,以便它的工作方式与Range.Cells相同?

完整代码是:

Option Explicit

Private pHeaderRange As Range

'
' Sets the Range of the header row.
'
' -r   Range   The header row is expected to the in the CurrentRegion of r.
'
Property Let Header(location As Range)

    ' if range is empty, only the top, left cell will be selected
        Dim r As Range
        Set r = location.CurrentRegion

    ' if top row is blank, then remove top row from the range
        If WorksheetFunction.CountA(r.Rows(1)) = 0 Then
            ' dont (and cant) resize unless there are multiple rows in the range
                If r.Rows.Count > 1 Then
                    Set r = r.Resize(r.Rows.Count - 1, r.Columns.Count).Offset(1, 0) ' resizes and repositions range
                Else
                    ' the is no header, only a blank cell
                        Set pHeaderRange = r
                        Exit Property
                End If
        End If

    ' find the starting column of the header row
        Dim startCell As Range
        Dim endCell As Range
        Set startCell = r.Cells(1, 1)

        If IsEmpty(startCell) Then
            ' if startCell is empty, look for header to the right
                Set startCell = r.End(xlToRight)
        ElseIf IsEmpty(startCell.Offset(0, -1)) Then
            ' if cell to the left is empty, we have already found the start of the header
        Else
            ' otherwise move to left to find the start
                Set startCell = startCell.End(xlToLeft)
        End If

        ' find the last column of the header row
            If IsEmpty(startCell.Cells(1, 2)) Then
                ' if cell to the right is empty, header row only contains one cell
                    Set endCell = startCell
            Else
                ' otherwise move to right to find the end
                    Set endCell = startCell.End(xlToRight)
            End If

    ' store the header range
        Set pHeaderRange = Range(startCell, endCell)

    ' debug
        pHeaderRange.Select

End Property


'
'
Public Property Get Cells(row As Long, col As Variant) As Range

    ' Get the column number for the requested cell
        Dim c As Long
        If IsNumeric(col) Then
            ' change to int
                c = CInt(col)
        ElseIf VarType(col) = vbString Then
            ' Get column by header name
                c = Me.Column(CStr(col))
        Else
            ' Otherwise, variant type is not supported
                Exit Property
        End If

    ' Return the requested Cell if column number is valid
        If c > 0 And c <= pHeaderRange.Columns.Count Then
            Set Cells = pHeaderRange.CurrentRegion.Cells(1 + row, c) ' the row is +1 because CurrentRegion also returns the header row
        End If

End Property
Public Property Set Cells(v As Range)
    ' some code here
End Property

'
' Returns the entire column range of the header that matches the index.
'
' -name String  The header name to find
'
Public Property Get Column(name As String) As Long

    ' Find header
        On Error Resume Next ' continue even if name is not found (ie Find returns an error)
        Dim r As Range
        Set r = pHeaderRange.Find(name)

    ' return column number
        Column = r.Column - pHeaderRange.Column + 1

End Property

2 个答案:

答案 0 :(得分:3)

http://msdn.microsoft.com/en-us/library/gg251357.aspx

  

同一属性的Property Get,Property Let和Property Set过程的参数必须完全匹配,但Property Let有一个额外参数,其类型必须与相应Property Get的返回类型匹配... < / p>

问题是你的Get中的参数不在你的Set中。所以这会起作用

Public Property Get Cells(lrow As Long, vcol As Variant) As Range


End Property
Public Property Set Cells(lrow As Long, vcol As Variant, v As Range)


End Property

除了没有意义(你已经知道)。 Cells在Excel对象模型中工作的原因是它是一个只读属性(有一个Get,但没有Let或Set)。 Cells属性返回Range对象,但不能设置Cells。我不确定你用Set语句想要完成什么,但也许你不需要它。您似乎没有任何模块级变量来存储它。

答案 1 :(得分:1)

如果我理解你的问题,也许你可以试试:

Public Property Set Cells(row As Long, col As Variant) As Range
    'code to set the class
End Property

请参阅此主题的一些提示:Set property of vba class with object reference