Обработка данных из файла

Пользователь

Сообщений: 58 Регистрация: 01.01.1970

11.11.2011 09:24:31

Всем привет!
Есть текстовый файл с записями (прикрепил) в формате: имя точки,ггггммчч,ччммсс,логин , записи такие делаются раз в две минуты для каждого логина. Надо это дело преобразовать в таблицу экселя, хотя бы по столбцам разбросать, но не просто так, а в виде:

имя точки, логин, дата, время первой записи, время последней.

Честно сказать, у меня даже фантазии на это дело не хватает %) Если кто поможет, буду премного благодарен

Прикрепленные файлы

post_276798.txt (88.52 КБ)

anvg

Пользователь

Сообщений: 11927 Регистрация: 22.12.2012

Excel 2016, 365

11.11.2011 09:53:29

1. Читаете файл построчно в строковые переменные sDot, sDate, sTime, sLogin, sNum
2. Используя Mid разбиваете дату и время на части (позиции элементов известны) и, используя DateSerial, TimeSerial, собираете в дату и время.
3. Используя Set pDict = CreateObject("Scripting.Dictionary) и класс данных (не понятно по каким полям будет группировка начала конца времени [пусть будет Dot and Login]) с полями
DotName, LoginName, DateValue, StartTime, EndTime проверяете есть ли в справочнике pDict строка sDot & sLogin
3.1 если есть, то обновляете по мин и макс время начала/конца, получив объект класса из справочника
3.2 если нет то создаёте новый объект класса и добавляете в справочник его с вышеуказанной строкой.
4. По окончании файла пишете из pDict.Values значения полей объектов на лист

KuklP Пользователь Сообщений: 14868 Регистрация: 21.12.2012 E-mail и реквизиты в профиле.	#3 11.11.2011 10:19:10 Макрорекордером. Поменяйте в коде путь к своему файлу. Прикрепленные файлы post_276813.xls (33 КБ) Я сам - дурнее всякого примера! ...

KuklP Пользователь Сообщений: 14868 Регистрация: 21.12.2012 E-mail и реквизиты в профиле.	#4 11.11.2011 10:21:55 Результат. Вчера обсуждалось, как менять столбцы местами. Прикрепленные файлы post_276814.rar (22.07 КБ) Я сам - дурнее всякого примера! ...

Hugo

Пользователь

Сообщений: 26326 Регистрация: 22.12.2012

11.11.2011 10:32:59

Как-то сложно получилось :)
Мне кажется, можно проще (если я правильно понял) -
читаем файл построчно,
сразу заводим словарь, куда заносим как уникальное имя точки+логин+дата
каждой записи добавляем массив из 2-х полей (или ведём общий массив из 5-ти полей для всех записей, по числу строк файла)
т.к. время записи имеет строгую последовательность, то мин/макс определять не нужно - в массив пишем в первое поле первое время при первой встреченной записи, и в второе поле все последующие (они затирают собой предыдущую запись)
В итоге выгружаем на лист результат перебором словаря или сразу выгрузкой заполненной части общего массива.

Вроде так.

ACrisefor Пользователь Сообщений: 58 Регистрация: 01.01.1970	#6 11.11.2011 11:06:34 почему то сообщения на форум не постятся KukLP, спасибо! Но это немного тоооо, посижу поковыряю

ACrisefor Пользователь Сообщений: 58 Регистрация: 01.01.1970	#7 11.11.2011 11:14:21 Hugo, да скорее всего так, но у меня с массивами в вба дружбы пока не складывается=(

Hugo

Пользователь

Сообщений: 26326 Регистрация: 22.12.2012

11.11.2011 12:39:36

Сделал в виде скрипта vbs.
Обрабатывает файл C:\tmp\ACrisefor\post_276798.txt
Можно добавить диалог выбора файла.
Сохраните код в текстовый файл с расширением vbs и запустите.
Но можно при желании и как макрос в xls использовать.
MsgBox "OK! Run in " & t
с таймером можно убрать, это чисто для информации.
Но если текстовые файлы по паре сотне мегабайт - то если не хватит памяти, то код нужно переделать.
Проверьте, всё ли правильно выводит.

Option Explicit

' FSO Constants
Const ForReading = 1
Const ForWriting = 2
Rem Const ForAppending = 8
Const TristateUseDefault = -2

' Variables
Dim objFSO, objTS, objExcel, a, aa, temp, t, i, ii
t = Timer

' Instantiate the object
Set objFSO = CreateObject("Scripting.FileSystemObject")

' open the text file read only
Set objTS = objFSO.OpenTextFile("C:\tmp\ACrisefor\post_276798.txt", ForReading, False, TristateUseDefault)

a = Split(objTS.ReadAll(), vbNewLine)
objTS.Close

ReDim b( UBound(a), 4)
ii = -1
With CreateObject("Scripting.Dictionary")

For i = 0 To UBound(a)
aa = Split(a(i), ",")
If UBound(aa) = 4 Then
temp = aa(0) & "|" & aa(1) & "|" & aa(3)
If Not .exists(temp) Then
ii = ii + 1
.Add temp, ii
b(ii, 0) = aa(0)
b(ii, 1) = aa(3)
b(ii, 2) = aa(1)
b(ii, 3) = aa(2)
Else
b(.Item(temp), 4) = aa(2)
End If
End If
Next

End With

Set objExcel = CreateObject("Excel.Application")
With objExcel.Workbooks.Add(1).Sheets(1)
.Range("a1:e1").Resize(ii + 1) = b
.Range("a1:e1").EntireColumn.AutoFit
End With
objExcel.Visible = True

' Close all files after we read it in.

Set objTS = Nothing
Set objFSO = Nothing
Set objExcel = Nothing

t = Timer - t
MsgBox "OK! Run in " & t

ACrisefor Пользователь Сообщений: 58 Регистрация: 01.01.1970	#9 14.11.2011 13:16:09 Хьюго спасибо! Если интересно, то мы вот так сделали =D правда формат времени и даты пока не сделал, но хоть так работает

ACrisefor Пользователь Сообщений: 58 Регистрация: 01.01.1970	#10 14.11.2011 13:17:25 вот Прикрепленные файлы post_277785.rar (13.29 КБ)

EducatedFool Пользователь Сообщений: 3695 Регистрация: 23.12.2012	#11 14.11.2011 13:19:26 А готовое решение поискать не пробовали? http://excelvba.ru/code/CSV2Excel Надстройки для Excel Парсинг сайтов Мониторинг цен конкурентов

Hugo Пользователь Сообщений: 26326 Регистрация: 22.12.2012	#12 14.11.2011 13:33:04 Интересно, но не посмотрел - 21.xltm в 2003 конвертер не берёт :( А чем vbs не понравился?

ACrisefor

Пользователь

Сообщений: 58 Регистрация: 01.01.1970

#13

15.11.2011 12:33:30

Hugo, ну у тебя как то проще выглядит=) просто я твоё сообщение поздно прочитал=)
вот конечный вариант, ещё листинг покажу

EducatedFool, я тут частенько ищу) да и как бы самому всё таки надо работать, а то как то нехорошо выходит.

Sub neww()
Application.ScreenUpdating = 0
Const n = 15
Dim a!, time!, b As String, i!, j!, iFile As String, strin() As String, temp As String, temp2() As String
iFile = Application.GetOpenFilename("Текстовый документ, *.txt", , "Выбрать документ")
If Dir(iFile) = "" Then Exit Sub
j = j + 1
Do While ThisWorkbook.Sheets("sheet2").Cells(j, 1) <> ""
j = j + 1
Loop
ThisWorkbook.Sheets("sheet2").Cells(j, 1) = iFile 'если не надо выводить название файла удали эту строку
j = j + 1 'и эту
i = 2
'Set xlsa = Workbooks.Open(Filename:=iFile, ReadOnly:=True)
Open iFile For Input As #1
'b = ts.readline 'xlsa.Sheets("shhet1").Cells(1, 4)
Line Input #1, b
strin = Split(b, ",")
temp2 = Split(strin(3), "\")
strin(3) = temp2(1)
ThisWorkbook.Sheets("sheet2").Cells(j, 1) = strin(3) 'xlsa.Sheets("shhet1").Cells(1, 4)
strin(1) = datetostr(strin(1))
ThisWorkbook.Sheets("sheet2").Cells(j, 2) = strin(1) 'xlsa.Sheets("shhet1").Cells(1, 2)
strin(2) = timetostr(strin(2))
ThisWorkbook.Sheets("sheet2").Cells(j, 3) = strin(2) 'xlsa.Sheets("shhet1").Cells(1, 3)
ThisWorkbook.Sheets("sheet2").Cells(j, 4) = strin(2) 'xlsa.Sheets("shhet1").Cells(1, 3)
Do While Not EOF(1) 'xlsa.Sheets("shhet1").Cells(i, 1) <> ""
temp = strin(3)
Line Input #1, b
strin = Split(b, ",")
temp2 = Split(strin(3), "\")
strin(3) = temp2(1)
If temp <> strin(3) Then 'xlsa.Sheets("shhet1").Cells(i, 4) Then
ThisWorkbook.Sheets("sheet2").Cells(j, 4) = del_x(ThisWorkbook.Sheets("sheet2").Cells(j, 4))
ThisWorkbook.Sheets("sheet2").Cells(j, 3) = del_x(ThisWorkbook.Sheets("sheet2").Cells(j, 3))
j = j + 1
ThisWorkbook.Sheets("sheet2").Cells(j, 1) = strin(3) 'xlsa.Sheets("shhet1").Cells(i, 4)
strin(1) = datetostr(strin(1))
ThisWorkbook.Sheets("sheet2").Cells(j, 2) = strin(1) 'xlsa.Sheets("shhet1").Cells(i, 2)
strin(2) = timetostr(strin(2))
ThisWorkbook.Sheets("sheet2").Cells(j, 3) = strin(2) 'xlsa.Sheets("shhet1").Cells(i, 3)
ThisWorkbook.Sheets("sheet2").Cells(j, 4) = strin(2) 'xlsa.Sheets("shhet1").Cells(i, 3)
b = strin(3) 'xlsa.Sheets("shhet1").Cells(i, 4)
Else
a = strin(2) 'xlsa.Sheets("shhet1").Cells(i, 3)
xx = ThisWorkbook.Sheets("sheet2").Cells(j, 3)
time = strtotime(ThisWorkbook.Sheets("sheet2").Cells(j, 3))
If a < time Then
ThisWorkbook.Sheets("sheet2").Cells(j, 3) = timetostr(a)
Else
time = strtotime(ThisWorkbook.Sheets("sheet2").Cells(j, 4))
If a > time Then ThisWorkbook.Sheets("sheet2").Cells(j, 4) = timetostr(a)
End If
End If
i = i + 1
Loop
ThisWorkbook.Sheets("sheet2").Cells(j, 4) = del_x(ThisWorkbook.Sheets("sheet2").Cells(j, 4))
ThisWorkbook.Sheets("sheet2").Cells(j, 3) = del_x(ThisWorkbook.Sheets("sheet2").Cells(j, 3))
'ThisWorkbook.Sheets("sheet2").Cells(j, 4) = strin(2) 'xlsa.Sheets("shhet1").Cells(i - 1, 3)
'xlsa.Close
Close #1
Application.ScreenUpdating = 1
End Sub
Function datetostr(a As String)
Dim temp As Long, temp2 As String
temp = CLng(a)
temp2 = temp Mod 100
temp = temp \ 100
temp2 = temp2 & "." & temp Mod 100
temp = temp \ 100
temp2 = temp2 & "." & temp Mod 100
datetostr = temp2
End Function
Function timetostr(ByVal xxx As String)
Dim temp As Long, temp2 As String
temp = CLng(xxx)
If temp Mod 100 > 9 Then
temp2 = temp Mod 100
Else
If temp Mod 100 = 0 Then
temp2 = "00"
Else
temp2 = "0" & temp Mod 100
End If
End If
temp = temp \ 100
If temp Mod 100 > 9 Then
temp2 = temp Mod 100 & ":" & temp2
Else
If temp Mod 100 = 0 Then
temp2 = "00:" & temp2
Else
temp2 = "0" & temp Mod 100 & ":" & temp2
End If
End If
temp = temp \ 100
If temp Mod 100 > 9 Then
temp2 = temp Mod 100 & ":" & temp2
Else
If temp Mod 100 = 0 Then
temp2 = "00:" & temp2
Else
temp2 = "0" & temp Mod 100 & ":" & temp2
End If
End If
timetostr = "x:" & temp2
End Function
Function strtotime(ByVal a As String)
Dim temp2 As String, temp() As String
temp = Split(a, ":")
temp2 = temp(1) & temp(2) & temp(3)
strtotime = temp2
End Function

Function del_x(sas As String)
Dim mas() As String
mas = Split(sas, ":")
del_x = mas(1) & ":" & mas(2) & ":" & mas(3)
End Function

Hugo Пользователь Сообщений: 26326 Регистрация: 22.12.2012	#14 15.11.2011 13:10:54 Не хотите эту кучу ThisWorkbook.Sheets("sheet2") заменить на одну строку With ThisWorkbook.Sheets("sheet2") много точек и одну строку End with

Hugo

Пользователь

Сообщений: 26326 Регистрация: 22.12.2012

#15

15.11.2011 13:25:16

У меня другие результаты - там ведь несколько дней процесс идёт:

KST-MO1 BANKRC\vpetrov 20111108 194000
KST-MO1 BANKRC\YuferovaYE 20111109 101200 132200
KST-MO1 SCBANK\do4spec4 20111109 132600 193800
KST-MO1 SCBANK\cash_19 20111110 101000 155400
URM-004 urm-004\sysadmin 20111107 162241 172001
URM-004 urm-004\sysadmin 20111110 100001 103001
URM-ENERGIYA URM-ENERGIYA\user 20111108 184002 185200
URM-ENERGIYA URM-ENERGIYA\user 20111109 94801 185000
URM-ENERGIYA URM-ENERGIYA\user 20111110 95202 155401
URM-MEGAMIR URM-MEGAMIR\user 20111108 181001 184401
URM-MEGAMIR URM-MEGAMIR\user 20111109 100400 184600
URM-MEGAMIR URM-MEGAMIR\user 20111110 103201 151000
URM-OSTROVSKOE URM-OSTROVSKOE\????????? 20111108 180800 182600
URM-OSTROVSKOE URM-OSTROVSKOE\????????? 20111109 75803 232600
URM-OSTROVSKOE URM-OSTROVSKOE\????????? 20111110 94409 155400

У Вас:
vpetrov 8.11.11 19:40:00 19:40:00
YuferovaYE 9.11.11 10:12:00 13:22:00
do4spec4 9.11.11 13:26:00 19:38:00
cash_19 10.11.11 10:10:00 15:54:00
sysadmin 7.11.11 10:00:01 17:20:01
user 8.11.11 9:48:01 18:52:00
????????? 8.11.11 7:58:03 23:26:00

Hugo Пользователь Сообщений: 26326 Регистрация: 22.12.2012	#16 15.11.2011 13:33:03 Т.е. результаты совпадают, но у Вас берётся одна дата (первая) и два времени (не понятно, из какого дня), у меня все даты и в каждой два времени. Как правильнее - не знаю. И Петров замечен один раз - нужно ли его писать как мин и мах?

Читают тему