Изменение формата даты в макросе / excel
Я пытаюсь добавить французскую версию в свой код. У меня есть макрос, который читает отчет из текстового файла и извлекает даты в правильном формате. Формат даты текстового файла — JUL13/2023. Мой макрос работает нормально, но иногда даты появляются на французском языке - JAN - январь, F:V - февраль, MAR - март, AVR - апрель, MAI - май, JUN - июнь, JLT - июль, AO} - август, SEP - сентябрь , OCT – октябрь, NOV – ноябрь, D:C – декабрь. Я пытаюсь найти лучшее решение, чтобы добавить его в свой код, чтобы он мог считывать все возможные даты и давать мне обычный формат даты в качестве вывода. Вот мой код:
Sub test()
Dim fn As String, mtch As Object, m As Object, s As Object, txt As String
Dim i As Long
fn = "C:\temp\test.txt"
txt =CreateObject("scripting.filesystemobject").OpenTextFile(fn).ReadAll
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "[^\n]+"
Set mtch = .Execute(txt)
i = 1
Dim b As Long
b = 1
For Each m In mtch
.Pattern = "[a-zA-Z0-9]{7}\s\s[^\s]+\s[a-zA-Z\s]*[0-9]{2}/[0-9]{4}"
For Each s In .Execute(m.Value)
i = i + 1
Cells(i, 1) = s
b = b + 1
Range("B" & b).Value = Right(Cells(i, 1), 10)
Next
Next
End With
Dim var As String
Dim N As Long, p As Long, j As Long
N = Cells(Rows.Count, "B").End(xlUp).Row
For p = 2 To N
var = Range("B" & p).Value
Range("C" & p).Value = convert_date(var)
Range("D" & p).Value = Range("C" & p) + 179
Range("E" & p).Value = Range("C" & p) + 209
j = j + 1
Next p
End Sub
Function convert_date(date_as_string As String) As Date
Dim mthstring As String
mthstring = "JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC"
convert_date = DateSerial( _
CInt(Right(date_as_string, 4)), _
CInt(((InStr(1, mthstring, Left(date_as_string, 3)) - 1) / 4) + 1), _
CInt(Replace(Mid(date_as_string, 4, 2), "/", "")))
End Function
Sub testConvertDate()
Dim var As String
Dim N As Long, i As Long, j As Long
N = Cells(Rows.Count, "B").End(xlUp).Row
Dim m As Integer
For i = 2 To N
'Range("B" & i).Value = Right("A" & i, 10)
var = Range("B" & i).Value
Range("C" & i).Value = convert_date(var)
Range("D" & i).Value = Range("C" & i) + 179
Range("E" & i).Value = Range("C" & i) + 209
j = j + 1
Next i
End Sub
И вот мой результат:
Ответы 2
Из-за того, что ваше перечисление названий месяцев во французском языке содержит строки из 3 или 4 символов, вам нужно обработать строку Date по-другому. Пожалуйста, попробуйте следующую адаптированную функцию. Не забудьте также скопировать функцию, возвращающую только числа (onlyNo):
Function convert_date(date_as_string As String) As Date
Dim mthstring As String, strLeft As String, arrD, dayNo As Long, monthNo As Long, y As Long
mthstring = "JANV,FEVR,MARS,AVRIL,MAI,JUIN,JUIL,AOUT,SEPT,OCT,NOV,DEC"
arrD = Split(mthstring, ",") 'place the string in an array
y = CLng(Split(date_as_string, "/")(1)) 'extract the year
strLeft = Split(date_as_string, "/")(0) 'extract the left string Date split by "/"
dayNo = onlyNo(strLeft) 'extract the day number
monthNo = Application.match(left(strLeft, Len(strLeft) - Len(CStr(dayNo))), arrD, 0) 'extract the month number
convert_date = DateSerial(y, monthNo, dayNo) 'convert to Date
End Function
Private Function onlyNo(strX As String) As Long
With CreateObject("vbscript.regexp")
.Pattern = "[^0-9]" 'replace everything except numbers
.Global = True
onlyNo = CLng(.replace(strX, "")) 'remove all letters
End With
End Function
Функция должна вызываться точно так же, как в вашем существующем коде.
Вы можете просто протестировать его, используя следующую подпрограмму тестирования. Пожалуйста, раскомментируйте закомментированные строки одну за другой и запустите его:
Sub testConvert_Date()
Dim d As String
d = "MAI31/2022"
'd = "JUIN20/2022"
'd = "NOV4/2022"
Debug.Print convert_date(d)
End Sub
Если вам нужно адаптировать функцию для работы, по запросу, и для английских названий дней, я могу легко адаптировать функцию, создав еще один параметр для выбора между языками.
Пожалуйста, отправьте отзыв после тестирования.
Option Explicit
Function convert_date(s As String) As Date
Dim ar, arLang(1), regex, v
Dim y As Integer, m As String, d As Integer
arLang(0) = Split("JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC", ",")
arLang(1) = Split("JANV,FEVR,MARS,AVRIL,MAI,JUIN,JUIL,AOUT,SEPT,OCT,NOV,DEC", ",")
Set regex = CreateObject("vbscript.regexp")
With regex
.Global = False
.MultiLine = False
.Ignorecase = True
.Pattern = "([A-Z]+)(\d{1,2})/(\d{4})"
End With
If regex.test(s) Then
With regex.Execute(s)(0)
m = .submatches(0)
d = .submatches(1)
y = .submatches(2)
End With
For Each ar In arLang
v = Application.Match(m, ar, 0)
If Not IsError(v) Then
convert_date = DateSerial(y, CInt(v), d)
Exit Function
End If
Next
End If
MsgBox s & " not correct format", vbExclamation
End Function