Я пытаюсь собрать воедино скрипт, чтобы обработать многие таблицы Excel, отформатированные определенным образом. Вторая часть скрипта работает нормально, но мне нужна помощь, чтобы сначала преобразовать определенные столбцы (число и позиция может измениться в будущем, поэтому я хочу явно назвать столбцы в коде) в текстовый формат yyyy-mm-dd потому что код выводит файл CSV, но файл CSV использует региональное форматирование даты. Существует также один столбец, столбец 7, который является временем даты, и я хочу сократить время. Наконец, мне нужно использовать диапазон ячеек, который не включает заголовки столбцов даты. В настоящее время столбец 1 буквально вынуждает все ячейки читать как «ГГГГ-ММ-ДД», а все остальные столбцы даты читаются правильно в Excel, но при экспорте возвращаются обратно в региональные даты. Большое спасибо.
Sub CSVFile()
Columns(1).NumberFormat = ”@”
Columns(1).NumberFormat = "YYYY-MM-DD"
Columns(7).NumberFormat = "YYYY-MM-DD"
Columns(8).NumberFormat = "YYYY-MM-DD"
Columns(9).NumberFormat = "YYYY-MM-DD"
Columns(11).NumberFormat = "YYYY-MM-DD"
Columns(16).NumberFormat = "YYYY-MM-DD"
Columns(28).NumberFormat = "YYYY-MM-DD"
Columns(29).NumberFormat = "YYYY-MM-DD"
Columns(31).NumberFormat = "YYYY-MM-DD"
Columns(33).NumberFormat = "YYYY-MM-DD"
Columns(36).NumberFormat = "YYYY-MM-DD"
Columns(39).NumberFormat = "YYYY-MM-DD"
Columns(40).NumberFormat = "YYYY-MM-DD"
Columns(44).NumberFormat = "YYYY-MM-DD"
Columns(45).NumberFormat = "YYYY-MM-DD"
Columns(48).NumberFormat = "YYYY-MM-DD"
Columns(49).NumberFormat = "YYYY-MM-DD"
Columns(50).NumberFormat = "YYYY-MM-DD"
Dim SrcRg As Range
Dim CurrRow As Range
Dim CurrCell As Range
Dim CurrTextStr As String
Dim ListSep As String
Dim FName As Variant
FName = Application.GetSaveAsFilename("", "CSV File (*.csv), *.csv")
ListSep = Application.International(xlListSeparator)
If Selection.Cells.Count > 1 Then
Set SrcRg = Selection
Else
Set SrcRg = ActiveSheet.UsedRange
End If
Open FName For Output As #1
For Each CurrRow In SrcRg.Rows
CurrTextStr = ìî
For Each CurrCell In CurrRow.Cells
If (CurrCell.Value = “NULL” Or Len(CurrCell.Value) < 1) Then
CurrTextStr = CurrTextStr & ListSep
Else
CurrTextStr = CurrTextStr & “”“” & Replace(CurrCell.Value, “”“”, “”“”“”) & “”“” & ListSep
End If
Next
While Right(CurrTextStr, 1) = ListSep
CurrTextStr = Left(CurrTextStr, Len(CurrTextStr) - 1)
Wend
Print #1, CurrTextStr
Next
Close #1
End Sub