访问VBA中另一个子对象中的对象字段

时间:2016-02-11 20:32:02

标签: vba excel-vba excel

我创建了一个对象来表示我想要从一个Excel工作表中找到并获取的三个值,然后将它们复制并粘贴到工作簿中另一个工作表的单元格中。在函数中创建对象后,我一直试图访问对象的字段。

Public CProduct

Private pEmea As Double
Private pRenewal As Double
Private pTotal As Double

'Emea Property
Public Property Get emea() As Double
    emea = pEmea
End Property
Public Property Let emea(Value As Double)
    pEmea = Value
End Property

'Renewal Property
Public Property Get Renewal() As Double
    Renewal = pRenewal
End Property
Public Property Let Renewal(Value As Double)
    pRenewal = Value
End Property

'Total Property
Public Property Get Total() As Double
    Total = pTotal
End Property
Public Property Let Total(Value As Double)
    pTotal = Value
End Property

Sub pipeWrapper()
Dim prod As CProduct
findVals "Testing", "A2:A55"
updatePipe findVals("Testing", "A2:A55"), "G6"

End Sub

Sub updatePipe(prod As CProduct, myCell As String)
Sheets("Weekly Pipeline Metrics").Activate

Sheets("Weekly Pipeline Metrics").range(myCell).Value = prod.emea
Sheets("Weekly Pipeline Metrics").range(myCell).Offset(1).Value = prod.Renewal
Sheets("Weekly Pipeline Metrics").range(myCell).Offset(2).Value = prod.Total


End Sub


Function findVals(pdct As String, rg As String) As CProduct
Dim prod As CProduct
Set prod = New CProduct


With Worksheets("Pipeline Raw Data").range(rg)
For Each ProductCell In Sheets("Pipeline Raw Data").range(rg)
    If ProductCell.Value = pdct Then
        For Each TypeCell In range(ProductCell.Offset(, 1), ProductCell.Offset(4, 1))
            If TypeCell.Value = "Renewal" And TypeCell.Offset(1).Value = "Subtotal" Then
                prod.emea = TypeCell.Offset(1, 2).Value
                prod.Total = TypeCell.Offset(1, 4).Value
                prod.Renewal = TypeCell.Offset(, 4).Value
        Exit For
    ElseIf TypeCell.Value = "New" And TypeCell.Offset(1).Value = "Subtotal" Then
        prod.Renewal = 0
        prod.Total = TypeCell.Offset(1, 4).Value
        prod.emea = TypeCell.Offset(1, 2).Value

    End If
    Next TypeCell
End If
Next ProductCell
End With
End Function

1 个答案:

答案 0 :(得分:0)

这里是代码示例(未经测试)。 HTH

Sub pipeWrapper()
    Dim prod As CProduct

    ' - Could I set a variable in the pipeWrapper sub to be the CProduct that results from calling findVals?
    ' Yes you can:
    set prod = findVals("Testing", "A2:A55")

    ' - Am i able to pass updatepipe findVals as a function object?
    ' Yes you can:
    updatePipe prod, "G6"
End Sub

Sub updatePipe(prod As CProduct, myCell As String)
    Sheets("Weekly Pipeline Metrics").Activate
    Sheets("Weekly Pipeline Metrics").range(myCell).Value = prod.emea ' This was wrong: CProduct.emea
    Sheets("Weekly Pipeline Metrics").range(myCell).Offset(1).Value = prod.Renewal ' This was wrong: CProduct.Renewal
    Sheets("Weekly Pipeline Metrics").range(myCell).Offset(2).Value = prod.Total ' This was wrong: CProduct.Total
End Sub