• Hàm sửa ngày
  • Hàm sửa ngày

    dotrung > 31-05-22, 11:27 PM

    Em xin nhờ các bác cao thủ hỗ trợ hàm gán ngày ạ ! 
    ví dụ: nếu suangay(31/06/2022) => trả về ngày cuối 30/06/2022, suangay(29/02/2022) => 28/02/2022 và không hiện msgbox thông báo nữa
    code:
    Public Function Suangay(N)
    Dim workstring, wposition, wdd, wmm, wyy As String
    If Not IsDate(N) Then
        MsgBoxOK DLookup("[NDUNG2]", "tblTHONGBAO", "[SOTB] = 15"), vbQuestion
        Suangay = Date
    Else
        workstring = N
        wposition = InStr(1, workstring, "/")
        wdd = Left(workstring, wposition - 1)
        workstring = Mid(workstring, wposition + 1)
        wposition = InStr(1, workstring, "/")
        If wposition = 0 Then
            wmm = workstring: wyy = Year(Date)
        Else
            wmm = Left(workstring, wposition - 1)
            wyy = Mid(workstring, wposition + 1)
        End If
        Suangay = DateSerial(wyy, wmm, wdd)
    End If
    End Function
  • RE: Hàm sửa ngày

    AnNguyen > 01-06-22, 08:55 AM

    Đây là cách làm của mình chưa bắt hết trường hợp lỗi 
    Mã:
    Public Function Suangay(str)
        If str <> "" Then
            Dim nam As Integer, thang As Integer, ngay As Integer, thoiGian As Date, ngayCuoiThang As Integer
            vitri1 = InStr(1, str, "/")
            vitri2 = InStr(vitri1 + 1, str, "/")
            ngay = Left(str, vitri1 - 1)
            thang = Mid(str, vitri1 + 1, vitri2 - vitri1 - 1)
            nam = Right(str, 4)
            If ngay = 0 Or thang = 0 Or nam = 0 Or thang > 12 Then
                MsgBox "ngày khong hop le"
            Else
            ngayCuoiThang = Day(DateAdd("m", 1, DateSerial(nam, thang, 1)) - 1)
            If ngay > ngayCuoiThang Then
                ngay = ngayCuoiThang
            End If
            Suangay = DateSerial(nam, thang, ngay)
            End If
        End If
    End Function