Question

我为我的公司编写了一个excel宏，在选择带序列号的单元格后，从该SN生成日期（日期在SN中编码），然后从另一个日期中减去该日期在几个月内生成产品生命周期的行。它作为具有命令按钮作为触发器的子程序非常有效（参见屏幕截图）。

Screenshot 1

现在我想将此宏用作某种公式，以便它返回行末尾的单元格中转换/计算的结果而不是消息框。我已经将子例程转换为函数，但它只返回＆＃34; #VALUE＆＃34;。谁能帮我？

以下是代码：

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：对不起，也许我没有说清楚自己（我不是母语人士）：我想像公式一样使用这个功能（＆＃34; = Lifetime（B2）＆＃ 34;例如），所以我可以向下拖动填充句柄并自动处理其他行，如下所示：

Screenshot 2

Answer 1

您可以通过编辑子程序来完成此操作。无需在公式中使用UDF。只需使用以下内容替换sub中的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

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

2 个答案: