Ошибка добавления даты, Case Else, кажется, не работает вообще - PullRequest
0 голосов
/ 08 апреля 2020
Function Zad3(x As String, y As Date)
    Dim z As String, c As Integer
    z = Right(x, 1)
    c = Left(Right(x, 2), 1)
    Select Case z
        Case Is = "M"
            Zad3 = DateAdd("m", c, y)
        Case Is = "R"
            Zad3 = DateAdd("yyyy", c, y)
        Case Is = "L"
            Zad3 = DateAdd("yyyy", c, y)
        Case Else
            Zad3 = "nieznana"
    End Select

End Function

enter image description here

Таким образом, "z" - это "L", "M" или "R", где "L", "R" = год и " М "= месяц. Мне нужно добавить к дате 3л, так что 3 года все работает. У меня есть проблема, где есть еще что-то, например "?". Это должно показать "nieznane" из-за другого случая, но это не так. ИДК, как это решить, есть идеи?

Ответы [ 2 ]

0 голосов
/ 08 апреля 2020

Условное изменение даты

Option Explicit

Function Zad3(SourceString As String, SourceDate As Date) As Variant

    ' Function restriction: only 1 to 9 months or years can be added.

    Dim strT As String  ' Type String
    Dim strN As String  ' Number String
    Dim lngN As Long    ' Number Number

    ' Check if there is at least two characters in SourceString.
    If Len(SourceString) < 2 Then GoTo Nieznana

    ' Calculate Type String (right-most character).
    strT = Right(SourceString, 1)
    ' Calculate Number String (first (left) of the two right-most characters).
    strN = Left(Right(SourceString, 2), 1)

    ' Check if Number String can be converted to a number.
    If Not IsNumeric(strN) Then GoTo Nieznana

    ' Convert Number String to Number Number.
    lngN = CLng(strN)

    ' It there was no IsNumeric:
'    On Error Resume Next
'        lngC = CLng(strN)
'        If Err.Number > 0 Then GoTo Nieznana
'    On Error GoTo 0

    ' Calculate resulting date (Zad3).
    Select Case strT
        Case Is = "M": Zad3 = DateAdd("m", lngN, SourceDate)
        Case Is = "R", "L": Zad3 = DateAdd("yyyy", lngN, SourceDate)
        Case Else: GoTo Nieznana
    End Select

Exit Function

Nieznana:
    ' 1. Source String has less than two characters.
    ' 2. Number String can not be converted to a number.
    ' 3. Type String is not "M", "R" or "L".
    Zad3 = "nieznana"

End Function
0 голосов
/ 08 апреля 2020

проблема заключается в:

c = Left(Right(x, 2), 1)

, что приведет к ошибке x = "?", Поскольку:

  • Влево (вправо (x, 2), 1) yeald "?"

  • c объявлен как Integer

, и интерпретатор VBA не может преобразовать "?" к любому целочисленному значению для c

, поэтому вы должны переместить это утверждение в соответствующие им и безопасные случаи

Function Zad3 (x As String, y As Date)
    Dim z As String, c As Integer
    z = Right(x, 1)
    Select Case z
        Case Is = "M"
            c = Left(Right(x, 2), 1)
            Zad3 = DateAdd("m", c, y)
        Case Is = "R"
            c = Left(Right(x, 2), 1)
            Zad3 = DateAdd("yyyy", c, y)
        Case Is = "L"
            c = Left(Right(x, 2), 1)
            Zad3 = DateAdd("yyyy", c, y)
        Case Else
            Zad3 = "nieznana"
    End Select

End Function

, краткая версия которых может быть

Public Function Zad3(x As String, y As Date)
    Dim z As String

    z = Right(x, 1)
    Select Case z
        Case "M", "R", "L"
            Zad3 = DateAdd(Switch(z = "M", "m", z = "R", "yyyy", z = "L", "yyyy"), Left(x, Len(x) - 1), y)

        Case Else
            Zad3 = "nieznana"
    End Select
End Function

, где я использовал функцию VBA Switch(), чтобы свернуть что было бы другим Select Case блоком

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...