将单元格内容传递给变量，处理它，然后将它返回到另一个单元格

Question

我已经为我的公司编写了一个excel宏，它在选择具有序列号的单元格后，从此SN生成日期（日期编码在SN中），然后从同一行中的另一个日期中减去此日期，以产生一个月的产品寿命。它作为一个具有命令按钮作为触发器的子例程很好地工作（请参见截图）。现在

我想用该宏为某种式的，以便它返回在细胞在该排的，而不是一个消息的结束的转换/计算的结果。我已经将该子例程转换为函数，但它只返回“#VALUE”。谁能帮我？

下面是代码：

Sub Lifetime() 

Dim c As String 
Dim m As String 
Dim y As String 
Dim d1 As String 
Dim d2 As String 
Dim d1cd As Date 
Dim d2cd As Date 
Dim d3 As Integer 

c = ActiveCell.Value 

If Len(c) = 9 Then 

    y = Mid(c, 2, 2) 
    c = Left(c, 1) 
    m = Asc(c) - 64 

    d1 = "20" + y & "/" & m & "/01" 
    d1d = CDate(d1) 

    d2 = ActiveCell.Offset(, 5).Value 
    d2d = CDate(d2) 

    d3 = DateDiff("m", d1d, d2d) 

    MsgBox ("Die Lifetime der Pumpe beträgt " & d3 & " Monate") 

ElseIf Len(c) = 12 Then 

    y = Mid(c, 3, 2) 
    m = Left(c, 2) 

    d1 = "20" + y & "/" & m & "/01" 
    d1d = CDate(d1) 

    d2 = ActiveCell.Offset(, 5).Value 
    d2d = CDate(d2) 

    d3 = DateDiff("m", d1d, d2d) 

    MsgBox ("Die Lifetime der Pumpe beträgt " & d3 & " Monate") 

Else 

    MsgBox ("Ungültige Seriennummer") 

End If 
End Sub 

PS：不好意思，可能是我没有讲清楚（我不是一个母语）：我想用这个功能就像一个公式（“=寿命（B2）”为例），这样我就可以向下拖动填充柄，它会自动处理其他行，像这样：

Screenshot 2

Answer 1

您可以通过编辑您的子程序做到这一点。不需要在公式中使用UDF。只需用下面的替换子的MsgBox线：

ActiveCell.End(xlToRight).Offset(0, 1) = "Die Lifetime der Pumpe beträgt " & d3 & " Monate" 

这应该在第一个空白单元输出的地方活动单元格的权利。

Answer 2

来自德国董事会“vba-forum.de”的用户帮助我重写脚本，现在它可以工作。这里是代码：

'Modul1 
Option Explicit 

Public Function Lifetime(SerialNr As Variant, DateRef As Variant) As Variant 

On Error GoTo ErrHandler 

Dim strDate As String 
Dim strYear As String 
Dim strMonth As String 
Dim dtm  As Date 
Dim dtmRef As Date 

strDate = Trim$(SerialNr) 
dtmRef = CDate(DateRef) 

If Len(strDate) = 9 Then 

    strYear = Mid$(strDate, 2, 2) 
    strMonth = CStr(Asc(strDate) - 64) 
    dtm = DateSerial(CInt("20" & strYear), CInt(strMonth), 1) 

    'MsgBox ("Die Lifetime der Pumpe beträgt " & d3 & " Monate") 
    Lifetime = DateDiff("m", dtm, dtmRef) 

    ElseIf Len(strDate) = 12 Then 

    strYear = Mid$(strDate, 3, 2) 
    strMonth = Left$(strDate, 2) 

    dtm = DateSerial(CInt("20" & strYear), CInt(strMonth), 1) 

    'MsgBox ("Die Lifetime der Pumpe beträgt " & d3 & " Monate") 
    Lifetime = DateDiff("m", dtm, dtmRef) 

Else 
    'MsgBox ("Ungültige Seriennummer") 
    Lifetime = CVErr(XlCVError.xlErrNA) 
End If 

Exit Function 

ErrHandler: 
Lifetime = CVErr(XlCVError.xlErrValue) 

End Function