Конкретные столбцы в Txt гггг-мм-дд - PullRequest
0 голосов
/ 18 марта 2019

Я пытаюсь собрать воедино скрипт, чтобы обработать многие таблицы 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...