VBS [VBS] Конвертация данных с формата txt в xls

josh · 25 Окт 2016

Здравствуйте!!!
Вопрос нужен скрипт конвертации данных с формата txt в xls.
Вид TXT :
Год=1999
Месяц=Декабрь
Число=11

Год=1998
Месяц=Октябрь
Число=22

Вид Excel:

Год Месяц Число
1998 октябрь 11
1999 декабрь 22

Заранее спасибо!!

Dragokas · 28 Окт 2016

Здравствуйте, josh !

Добро пожаловать на SafeZone.

josh написал(а):
Вопрос нужен скрипт конвертации данных с формата txt в xls.

Лучше приложите сам txt-файл. Т.к. он бывает в разных кодировках, а это нужно учитывать.

Для ANSI формата, скрипт будет выглядеть так:

VB.NET / VBA:

Option Explicit

const xlWorkbookDefault = 51 'xlsx
const xlWorkbookNormal = -4143

Dim oFSO, sFile, sXLS, oFile, oTS, sText, oExcel, oBook, oSheet, curDir, arr, aText, i, y, pos, key, value

Set oFSO = CreateObject("Scripting.FileSystemObject")
curDir = oFSO.GetParentFolderName(WScript.ScriptFullName)

'curDir - папка со скриптом
' путь к файлу TXT
sFile = oFSO.BuildPath(curDir, "Data.txt")
' путь к создаваемому XLS
sXLS = oFSO.BuildPath(curDir, "Data.xls")

if oFSO.FileExists(sFile) then
  Set oFile = oFSO.GetFile(sFile)
  Set oTS = oFile.OpenAsTextStream(1)
  sText = oTS.ReadAll()
  oTS.Close
else
  msgbox "Указанный файл не существует: " & sFile
  WScript.Quit (1)
end if

'создание книги
set oExcel = createObject("Excel.Application")
oExcel.Visible = true
oExcel.DisplayAlerts = False
set oBook = oExcel.WorkBooks.Add
set oSheet = oBook.ActiveSheet

sText = Replace(sText, vbCr, "")
aText = Split(sText, vbLf)

y=1
'заголовок
oSheet.cells(y, 1) = "Год"
oSheet.cells(y, 2) = "Месяц"
oSheet.cells(y, 3) = "Число"
y=y+1

for i = 0 to UBound(aText)
  pos = instr(aText(i), "=")
  if pos <> 0 then
    key = Left(aText(i), pos-1)
    value = Mid(aText(i), pos+1)
    if key = "Год" then oSheet.cells(y, 1) = value
    if key = "Месяц" then oSheet.cells(y, 2) = value
    if key = "Число" then oSheet.cells(y, 3) = value: y=y+1
  end if
next

'сохранение книги
oBook.SaveAs sXLS, xlWorkbookNormal
oBook.Close (true)
oExcel.DisplayAlerts = True
oExcel.Quit

set oSheet = Nothing
set oBook = Nothing
set oExcel = Nothing
set oTS = Nothing
set oFile = Nothing
set oFSO = Nothing

oExcel.Visible = true можете сменить на false, чтобы окно не мелькало.

josh · 3 Дек 2016

Большое спасибо!!
ВОПРОС: Разделителем здесь служит знак (=),как быть если разделителем должно быть слово?
Пример
Вид годового календаря:2017
Год=2017
Месяц= декабрь
число=23

Вид excel
календарь год месяц число
календаря:2017 2017 декабрь 23

Заранее спасибо.

Dragokas · 3 Дек 2016

Не вижу, чтобы у Вас разделителем было слово.
Вижу, что Вы добавили новое поле в начало и поместили в него фразу "календаря:2017", правда по каким криятериям вы её от туда извлекли мне неизвестно.
И лучше всё же более длинный пример (как в 1-м посту).

josh · 4 Дек 2016

Исходник

create annual calendar: 2017 (убрать create annual, а оставить calendar: 2017)
set annual calendar: 2017 (убрать set annual, а оставить calendar: 2017)
year = 2017
month = Dec
number = 23

create annual calendar: 2016
set annual calendar: 2016
year = 2016
month = Oct
number = 22

Вид в Excel
calendar Present year Year Month Number
calendar: 2017 calendar: 2017 2017 Dec 23
calendar: 2016 calendar: 2016 2016 Oct 22

Заранее спасибо!!
вид excel

Dragokas · 4 Дек 2016

Пожалуйста.

VB.NET / VBA:

Option Explicit

const xlWorkbookDefault = 51 'xlsx
const xlWorkbookNormal = -4143

Dim oFSO, sFile, sXLS, oFile, oTS, sText, oExcel, oBook, oSheet, curDir, arr, aText, i, y, pos, key, value

Set oFSO = CreateObject("Scripting.FileSystemObject")
curDir = oFSO.GetParentFolderName(WScript.ScriptFullName)

'curDir - папка со скриптом
' путь к файлу TXT
sFile = oFSO.BuildPath(curDir, "Data.txt")
' путь к создаваемому XLS
sXLS = oFSO.BuildPath(curDir, "Data.xls")

if oFSO.FileExists(sFile) then
  Set oFile = oFSO.GetFile(sFile)
  Set oTS = oFile.OpenAsTextStream(1)
  sText = oTS.ReadAll()
  oTS.Close
else
  msgbox "Указанный файл не существует: " & sFile
  WScript.Quit (1)
end if

'создание книги
set oExcel = createObject("Excel.Application")
oExcel.Visible = false
oExcel.DisplayAlerts = False
set oBook = oExcel.WorkBooks.Add
set oSheet = oBook.ActiveSheet

sText = Replace(sText, vbCr, "")
aText = Split(sText, vbLf)

y=1
'заголовок
oSheet.cells(y, 1) = "calendar"
oSheet.cells(y, 2) = "Present year"
oSheet.cells(y, 3) = "Year"
oSheet.cells(y, 4) = "Month"
oSheet.cells(y, 5) = "Number"

y=y+1

for i = 0 to UBound(aText)
  key = ""
  ' если пара ключ-значение записано через =
  pos = instr(aText(i), "=")
  if pos = 0 then
    'если значение находится после 2-го пробела
    pos = instr(aText(i), " ")
    if pos <> 0 then
      pos = instr(pos + 1, aText(i), " ")
    end if
  end if
  if pos <> 0 then
    key = trim(Left(aText(i), pos-1))
    value = trim(Mid(aText(i), pos+1)) 
  end if
  if key <> "" then
    if key = "create annual" then oSheet.cells(y, 1) = value
    if key = "set annual" then oSheet.cells(y, 2) = value
    if key = "year" then oSheet.cells(y, 3) = value
    if key = "month" then oSheet.cells(y, 4) = value   
    if key = "number" then oSheet.cells(y, 5) = value: y=y+1 ' признак последней строки
  end if
next

'сохранение книги
oBook.SaveAs sXLS, xlWorkbookNormal
oBook.Close (true)
oExcel.DisplayAlerts = True
oExcel.Quit

set oSheet = Nothing
set oBook = Nothing
set oExcel = Nothing
set oTS = Nothing
set oFile = Nothing
set oFSO = Nothing

josh · 5 Дек 2016

А если файл-исходник имеет знаки табуляции, и view doc надо убрать?
Заранее огромное спасибо!

Dragokas · 7 Дек 2016

В итоге исходный формат файла совершенно другой, чем в 1-м посте. Ещё и циферки нумерации какие-то появились. Не мучали бы меня, а сразу дали бы нормальный образец. И код возможно бы получился проще.

VB.NET / VBA:

Option Explicit

const xlWorkbookDefault = 51 'xlsx
const xlWorkbookNormal = -4143

Dim oFSO, sFile, sXLS, oFile, oTS, sText, oExcel, oBook, oSheet, curDir, arr, aText, i, y, pos, pos1, pos2, pos3, key, value

Set oFSO = CreateObject("Scripting.FileSystemObject")
curDir = oFSO.GetParentFolderName(WScript.ScriptFullName)

'curDir - папка со скриптом
' путь к файлу TXT
sFile = oFSO.BuildPath(curDir, "Data.txt")
' путь к создаваемому XLS
sXLS = oFSO.BuildPath(curDir, "Data.xls")

if oFSO.FileExists(sFile) then
  Set oFile = oFSO.GetFile(sFile)
  Set oTS = oFile.OpenAsTextStream(1)
  sText = oTS.ReadAll()
  oTS.Close
else
  msgbox "Указанный файл не существует: " & sFile
  WScript.Quit (1)
end if

'создание книги
set oExcel = createObject("Excel.Application")
oExcel.Visible = false
oExcel.DisplayAlerts = False
set oBook = oExcel.WorkBooks.Add
set oSheet = oBook.ActiveSheet

sText = Replace(sText, vbCr, "")
aText = Split(sText, vbLf)

y=1
'заголовок
oSheet.cells(y, 1) = "calendar"
oSheet.cells(y, 2) = "Present year"
oSheet.cells(y, 3) = "Year"
oSheet.cells(y, 4) = "Month"
oSheet.cells(y, 5) = "Number"

y=y+1

for i = 0 to UBound(aText)
  key = ""
  ' если пара ключ-значение записано через =
  pos = instr(aText(i), "=")
  if pos <> 0 then
    key = trimEx(Left(aText(i), pos-1))
    value = trimEx(Mid(aText(i), pos+1)) 
  else
    'если значение находится после 3-го пробела, а ключ - между 1-м и 3-м
    pos1 = instr(aText(i), " ")
    if pos1 <> 0 then
      pos2 = instr(pos1 + 1, aText(i), " ")
      if pos2 <> 0 then
        pos3 = instr(pos2 + 1, aText(i), " ")
        if pos3 <> 0 then
          key = trimEx(Mid(aText(i), pos1+1, pos3 - pos1 - 1))
          value = trimEx(Mid(aText(i), pos3+1))
          'отрезать с конца "view doc"
          if StrEndWith(value, "view doc") then value = TrimEx(left(value, Len(value) - Len("view doc")))        
        end if
      end if
    end if
  end if
  if key <> "" then
    if StrComp(key, "create annual", 1) = 0 then oSheet.cells(y, 1) = value
    if StrComp(key, "set annual", 1) = 0 then oSheet.cells(y, 2) = value
    if StrComp(key, "year", 1) = 0 then oSheet.cells(y, 3) = value
    if StrComp(key, "month", 1) = 0 then oSheet.cells(y, 4) = value   
    if StrComp(key, "number", 1) = 0 then oSheet.cells(y, 5) = value: y=y+1 ' признак последней строки
  end if
next

'сохранение книги
oBook.SaveAs sXLS, xlWorkbookNormal
oBook.Close (true)
oExcel.DisplayAlerts = True
oExcel.Quit

set oSheet = Nothing
set oBook = Nothing
set oExcel = Nothing
set oTS = Nothing
set oFile = Nothing
set oFSO = Nothing

'удаление обрамляющих пробелов и знаков табуляции
function TrimEx(sStr)
  Dim s
  s = Trim(sStr)
  Do While Left(s, 1) = vbTab
    s = mid(s, 2)
  Loop
  Do While Right(s, 1) = vbTab
    s = Left(s, Len(s) - 1)
  Loop
  TrimEx = Trim(s)
end function

function StrEndWith(Text, LastPart)
  StrEndWith = (StrComp(Right(Text, Len(LastPart)), LastPart, 1) = 0)
end function

josh · 11 Дек 2016

Все получилось. Спасибо. Варианты выгрузки просто разные, поэтому такие метания.

VBS [VBS] Конвертация данных с формата txt в xls

josh

Новый пользователь

Dragokas

Angry & Scary Developer

Вложения

josh

Новый пользователь

Dragokas

Angry & Scary Developer

josh

Новый пользователь

Вложения

Dragokas

Angry & Scary Developer

Вложения

josh

Новый пользователь

Вложения

Dragokas

Angry & Scary Developer

Вложения

josh

Новый пользователь

Похожие темы