MyTetra Share
Делитесь знаниями!
ice cream cup clipart on Boxtutor
басурманский формат даты
31.07.2019
22:37
Текстовые метки: басурманский формат даты
Раздел: !Закладки - VBA

'================================================================================

'##### Преобразует дату в басурманский формат

'

'Sub test_FnDateRu_En()

' strDate = "7/18/2031"

'' strDateNew = FnDateRu_En(strDate)

' strDateNew = FnDateEn_Ru(strDate)

'End Sub

'--------------------------------------------------------------------------------

Function FnDateRu_En(ByVal strDate As String) As String

If Len(strDate) = 0 Then strDate = Now

m = Split(strDate, ".", -1, vbBinaryCompare)

If Left(m(0), 1) = 0 Then m(0) = Right(m(0), Len(m(0) - 1))

If Left(m(1), 1) = 0 Then m(1) = Right(m(1), Len(m(1) - 1))

FnDateRu_En = m(1) & "/" & m(0) & "/" & Left(m(2), 4)

End Function

'================================================================================

'================================================================================

'##### Преобразует из басурманского формата

'

'--------------------------------------------------------------------------------

Function FnDateEn_Ru(ByVal strDate As String) As String

m = Split(strDate, "/", -1, vbBinaryCompare)

If Len(m(0)) = 1 Then m(0) = "0" & m(0)

If Len(m(1)) = 1 Then m(1) = "0" & m(1)

FnDateEn_Ru = m(1) & "." & m(0) & "." & m(2)

End Function

'================================================================================

'================================================================================

'Минимальное-максимальное значение даты в массиве

'пееременные дат объявить в модуле

'Dim dDateVal As Date, dDateMin As Date, dDateMax As Date

'Dim strDateMin As String, strDateMax As String, strDate As String

'bln_CalculateDatePSFV-датуPSFV

'--------------------------------------------------------------------------------------------------

Sub Date_Min_Max(ByVal ar As Variant, _

ByVal bln_CalculateDatePSFV As Boolean)

If IsArray(ar) Then

dDateMin = Format(ar(LBound(ar), UBound(ar)), "DD.MM.YYYY")

dDateMax = dDateMin

Select Case bln_CalculateDatePSFV

Case True

For j = LBound(ar, 2) To UBound(ar, 2)

If Format(ar(0, j), "hh:mm:ss") < "07:00:00" Then

dDateVal = Format(CDate(ar(0, j)) - 1, "DD.MM.YYYY")

Else

dDateVal = Format(ar(0, j), "DD.MM.YYYY")

End If

If dDateVal < dDateMin Then dDateMin = dDateVal

If dDateVal > dDateMax Then dDateMax = dDateVal

Next j

Case False

For j = LBound(ar, 2) To UBound(ar, 2)

dDateVal = Format(ar(0, j), "DD.MM.YYYY")

If dDateVal < dDateMin Then dDateMin = dDateVal

If dDateVal > dDateMax Then dDateMax = dDateVal

Next j

End Select

If IsDate(dDateMin) Then strDateMin = fin_DateSQL(dDateMin)

If IsDate(dDateMax) Then strDateMax = fin_DateSQL(dDateMax)

End If

End Sub

'===============================================================================









'============================================================================================

'##### 'Поиск максимального(минимального) занчения даты

'дата для SQL

Function funSqlDate(ByVal dDate As Variant) As String

Dim strD As String, strM As String, strY As String

strD = Format(dDate, "DD")

strM = Format(dDate, "MM")

strY = Format(dDate, "YYYY")

funSqlDate = strM & "/" & strD & "/" & strY

End Function

'--------------------------------------------------------------------------------------------

Function fundDate(ByVal blnMax As Boolean, _

ByVal aDate As Variant) As Date

Dim iDate As Long, dDate As Date

Dim intLbound As Integer: intLbound = LBound(aDate)

fundDate = CDate(Trim(aDate(intLbound, LBound(aDate))))


Select Case blnMax

Case True:

For iDate = LBound(aDate) To UBound(aDate, 2)

If Len(Trim(aDate(intLbound, iDate))) > 0 Then

dDate = CDate(Trim(aDate(intLbound, iDate)))

If dDate > fundDate Then fundDate = dDate

End If

Next iDate

Case False:

For iDate = LBound(aDate) To UBound(aDate, 2)

If Len(Trim(aDate(intLbound, iDate))) > 0 Then

dDate = CDate(Trim(aDate(intLbound, iDate)))

If dDate < fundDate Then fundDate = dDate

End If

Next iDate

End Select

End Function

'============================================================================================

Так же в этом разделе:
 
MyTetra Share v.0.52
Яндекс индекс цитирования