Всем привет !!!
Столкнулся с таким курьезом !
Имею логи с сотовой станции, логи пишутся через каждые 15 мин.
Программа должна снять суточный трафик и выдать это все в гистограмме и линейной диаграмме . Программа работает , но сам импорт занимает очень долгое время,
порядка 30мин. Логи с Линукса, все в текстовом файле вот кусок :

BTS_DATA_RECORD 2004-11-08 00:00:00 2004-11-08 00:15:00 TurboMAX_BSPLUS.TurboMAX_BSPLUS_bts_0-Cel 20100 1
nbrOfAvailableTCHs = 7
meanNbrOfBusyTCHs = 0
maxNbrOfBusyTCHs = 1
meanNbrOfIdleTCHsPerInterferenceBand = 6, 0, 0, 0, 0
attTCHSeizures = 2
succTCHSeizures = 2
nbrOfAvailableSDCCHs = 4
meanNbrOfBusySDCCHs = 0
maxNbrOfBusySDCCHs = 1
attSDCCHSeizures = 2
attSDCCHSeizuresFailures = 0
accAGCH = 2
accPagingChannel = 2
succAccProcCMReEst = 0
succAccProcCMServ = 0
succAccProcIMSIDet = 0
succAccProcLocUpd = 0
succAccProcPageRsp = 2
succAccProcRACH = 2
succImmediateAssingProcsEmgCall = 0
succImmediateAssingProcsCMReEst = 0
succImmediateAssingProcsPageRsp = 2
succImmediateAssingProcsOrigCall = 0
succImmediateAssingProcsLocUpd = 0
succImmediateAssingProcsOthers = 0
maxNbrOfBlockCH = 0
chanReqMSFail = 0
MinQualityUL = 0
MaxQualityUL = 1
MeanQualityUL = 0
TotalQualityDurationUL = 7001, 671, 0, 0, 0, 0, 0, 0
TotalQualitySamplesUL = 157
CumulativeQualityDistributionUL = 93, 100, 100, 100, 100, 100, 100, 100

Лог порядка 8000 строк , всего логов 96.
Происходит все так :

Код

Dim MyFile, BookName, MyBookName As String Sheets("Import").Select Cells.Select    Selection.ClearContents  ChDir "C:\BTSLOG"  ggg = 1    For m = 1 To ListBox2.ListCount       ListBox2.SetFocus: ListBox2.ListIndex = m - 1: DoEvents                 MyFile = "C:\BTSLOG\" & ListBox2             Workbooks.OpenText Filename:= _             MyFile, Origin:=437, StartRow _             :=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _        ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _        , Space:=False, Other:=False, FieldInfo:=Array(1, 1), _        TrailingMinusNumbers:=True        BookName = ListBox2      Dim NameSheet, NameTime As Variant Fix1 = Len(ListBox2) MyBookName = Mid(ListBox2, 1, Fix1 - 4) For n = 1 To ListBox1.ListCount      ListBox1.SetFocus: ListBox1.ListIndex = n - 1: DoEvents       s = Len(ListBox1) ff = 1 While Workbooks(MyBookName).Worksheets(MyBookName).Cells(ff, 1) <> Empty If Mid(Workbooks(MyBookName).Worksheets(MyBookName).Cells(ff, 1), 1, 8) = "BTS_DATA" Then NameSheet = Mid(Right(Trim(Workbooks(MyBookName).Worksheets(MyBookName).Cells(ff, 1)), 8), 1, 5): NameTime = Mid(Trim(Workbooks(MyBookName).Worksheets(MyBookName).Cells(ff, 1)), 33, 6): GoTo ross If Workbooks(MyBookName).Worksheets(MyBookName).Cells(ff, 1) = "END" Then GoTo ross If Mid(Workbooks(MyBookName).Worksheets(MyBookName).Cells(ff, 1), 1, s) = ListBox1 Then _ ggg = ggg + 1: Workbooks("BSS222_Diagram").Worksheets("Import").Cells(ggg, 3) = NameSheet: Workbooks("BSS222_Diagram").Worksheets("Import").Cells(ggg, 4) = NameTime: _ Workbooks("BSS222_Diagram").Worksheets("Import").Cells(ggg, 1) = ListBox1: _ Workbooks("BSS222_Diagram").Worksheets("Import").Cells(ggg, 2) = Trim(Mid(Workbooks(MyBookName).Worksheets(MyBookName).Cells(ff, 1), InStr(4, Workbooks(MyBookName).Worksheets(MyBookName).Cells(ff, 1), "=", 1) + 1)) ross: ff = ff + 1 Wend Next Workbooks(MyBookName).Close Next End Sub

ListBox1 - это список нужных параметров их всегда порядка 20 наименований
Но весь импорт занимает очень долгое время , может кто подскажет , что тут оптимизировать.
С Уважением !
Илларион
г. Ленск

Для начала, замени Workbooks(MyBookName).Worksheets(MyBookName).Cells(ff, 1) на переменую.
И код читать полегче будет и возможно повлияет на скорость выполнения (надеюсь, что в лучшую сторону)

Код

ff = 1 While Workbooks(MyBookName).Worksheets(MyBookName).Cells(ff, 1) <> Empty    FF_Cell = Workbooks(MyBookName).Worksheets(MyBookName).Cells(ff, 1)    If Mid(FF_Cell , 1, 8) = "BTS_DATA" Then NameSheet = Mid(Right(FF_Cell, 8), 1, 5): NameTime = Mid(Trim(FF_Cell , 33, 6): GoTo ross ... и т.д.

Хм... да...
Пардон конечно за то , что нет ремаров , ну, а причем тут переменная ?! будет меньше листинг и только или как ?.... ладно использую Set и что сразу все залетает ?
Там просто три цикла ........ мне кажется , что все по колхозному из-за этого.....((

Код

[code=vb] Dim MyFile, BookName, MyBookName As String Sheets("Import").Select ' Активизируем старый лист с Импортом Cells.Select ' Выделяем весь лист   Selection.ClearContents ' Все грохаем ChDir "C:\BTSLOG" ' Смена директории на каталог с лог файлами ggg = 1 ' дентефикатор на продолжение записи в основной базе   For m = 1 To ListBox2.ListCount ' Список  лог файлов (всего 96 )      ListBox2.SetFocus: ListBox2.ListIndex = m - 1: DoEvents ' Шуруем по первому циклу              MyFile = "C:\BTSLOG\" & ListBox2 ' Открываем очередной лог-файл            Workbooks.OpenText Filename:= _            MyFile, Origin:=437, StartRow _            :=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _       ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:=False _       , Space:=False, Other:=False, FieldInfo:=Array(1, 1), _       TrailingMinusNumbers:=True   BookName = ListBox2 ' Тут не играем , тут рыбу заворачиваем :)))   Dim NameSheet, NameTime As Variant Fix1 = Len(ListBox2) ' Считаем количество символов в именм файла , что бы отделить расширение MyBookName = Mid(ListBox2, 1, Fix1 - 4)' Отделяем расширение For n = 1 To ListBox1.ListCount ' Список искомых параметров     ListBox1.SetFocus: ListBox1.ListIndex = n - 1: DoEvents      s = Len(ListBox1)' Надеюсь понятно ...... ff = 1 ' начинаем 3 цикл, пробегаем открытый лог от начала до конца и так по каждому параметру While Workbooks(MyBookName).Worksheets(MyBookName).Cells(ff, 1) <> Empty If Mid(Workbooks(MyBookName).Worksheets(MyBookName).Cells(ff, 1), 1, 8) = "BTS_DATA" Then NameSheet = Mid(Right(Trim(Workbooks(MyBookName).Worksheets(MyBookName).Cells(ff, 1)), 8), 1, 5): NameTime = Mid(Trim(Workbooks(MyBookName).Worksheets(MyBookName).Cells(ff, 1)), 33, 6): GoTo ross If Workbooks(MyBookName).Worksheets(MyBookName).Cells(ff, 1) = "END" Then GoTo ross If Mid(Workbooks(MyBookName).Worksheets(MyBookName).Cells(ff, 1), 1, s) = ListBox1 Then _ ggg = ggg + 1: Workbooks("BSS222_Diagram").Worksheets("Import").Cells(ggg, 3) = NameSheet: Workbooks("BSS222_Diagram").Worksheets("Import").Cells(ggg, 4) = NameTime: _ Workbooks("BSS222_Diagram").Worksheets("Import").Cells(ggg, 1) = ListBox1: _ Workbooks("BSS222_Diagram").Worksheets("Import").Cells(ggg, 2) = Trim(Mid(Workbooks(MyBookName).Worksheets(MyBookName).Cells(ff, 1), InStr(4, Workbooks(MyBookName).Worksheets(MyBookName).Cells(ff, 1), "=", 1) + 1)) ross: ff = ff + 1 Wend Next Workbooks(MyBookName).Close' ну вот, когда все прошелестели закрываем лог .....и так 19 раз Next End Sub

Я пробывал иначе делал наоборот в один проход по логу перебирал весь список параметров , но увы, результат один и тот ....(((

Alles, во первых читать легче, что уже не маловажно.
А во вторых скорость чтения из переменной быстрее чем из объекта.

Хорошо учту ...

"Workbooks.OpenText"
Сами логи хранятся в тексте?
Если да, тогда зачем нужен Workbooks.

Хм... это тоже вопрос !
Тут маневр такой .


BTS_DATA_RECORD 2004-11-08 00:00:00 2004-11-08 00:15:00 TurboMAX_BSPLUS.TurboMAX_BSPLUS_bts_0-Cel 20100 1 - Вот это грубо говоря устройсво, их пока всего 5 т.е :
10100
10200
10300
20100
20200

Вот по каждому устройству пишется лог , в каждом устройстве около 1000 параметров , включая мусор с дополнительных устройств. Итого вылазиит около 7800-8000 строк.
считывать значения мне приходиться по строкам . Начинаем с первой строки т.е.
BTS_DATA_RECORD 2004-11-08 00:00:00 2004-11-08 00:15:00 TurboMAX_BSPLUS.TurboMAX_BSPLUS_bts_0-Cel 20100
я делаю цикл с первой строки и объявляю , что это устройство [20100 .
Для меня заморока состоит в том , что это не текстовый файл с разделителями , а нечто слитое все в одну строку и из которого я должен выдрать :
параметр значение устройство время

Тут мне кто то на досуге посоветовал на Перле все сделать , но увы я в нем как свинья в апельсинах , пардон за каламбур........................ (((

Вот так выглядит лог на самом деле. При открытии Excel - ом все в полне сносно как указанно выше т. е по строкам.

BTS_DATA_RECORD 2004-11-08 00:00:00 2004-11-08 00:15:00 TurboMAX_BSPLUS.TurboMAX_BSPLUS_bts_0-Cel 20100 1
nbrOfAvailableTCHs = 7meanNbrOfBusyTCHs = 0maxNbrOfBusyTCHs=1meanNbrOfIdleTCHsPerInterferenceBand = 6, 0, 0, 0, 0attTCHSeizures = 2succTCHSeizures = 2nbrOfAvailableSDCCHs = 4meanNbrOfBusySDCCHs = 0maxNbrOfBusySDCCHs = 1attSDCCHSeizures = 2attSDCCHSeizuresFailures = 0accAGCH = 2accPagingChannel = 2succAccProcCMReEst = 0succAccProcCMServ = 0succAccProcIMSIDet = 0succAccProcLocUpd = 0succAccProcPageRsp = 2succAccProcRACH = 2succImmediateAssingProcsEmgCall = 0succImmediateAssingProcsCMReEst = 0succImmediateAssingProcsPageRsp = 2succImmediateAssingProcsOrigCall = 0succImmediateAssingProcsLocUpd = 0
BTS_DATA_RECORD 2004-11-08 00:00:00 2004-11-08 00:15:00 TurboMAX_BSPLUS.TurboMAX_BSPLUS_bts_0-Cel 20200

Выложи в txt (или на мыло кинь), я покручу и в виде класса выдам обработчик.
Txt нужен чтобы точно, до запятой и пробела быть уверенным в результате.

Это сообщение отредактировал(а) Vach - 13.11.2004, 00:07

Всем опять привет !!!
прошу прощения за назойливость, но вот , что у меня получилось :

Код

' Первый цикл по списку1 ( это файлы ) ' Второй цикл по списку2 ( это список параметров ) ChDir "C:\BTSLOG" MyFile = ListBox2 Dim InputData Open MyFile For Input As FreeFile Do While Not EOF(1)     ' кидаем строку в переменную  If Mid(InputData, 1, 8) = "BTS_DATA" Then NameSheet = Mid(Right(Trim(InputData), 8), 1, 5): NameTime = Mid(Trim(InputData), 33, 6): GoTo Ross If InputData = "END" Then GoTo Ross  If Mid(InputData, 1, s) = ListBox1 Then _ ggg = ggg + 1: Workbooks("BSS222_Diagram").Worksheets("Import").Cells(ggg, 3) = NameSheet: Workbooks("BSS222_Diagram").Worksheets("Import").Cells(ggg, 4) = Trim(NameTime): _ Workbooks("BSS222_Diagram").Worksheets("Import").Cells(ggg, 1) = ListBox1: _ Workbooks("BSS222_Diagram").Worksheets("Import").Cells(ggg, 2) = Trim(Mid(InputData, InStr(4, InputData, "=", 1) + 1)) Ross: Loop Close #1 ' Конец первого цикла ' Конец второго цикла

Время обработки всех файлов сократилось с 40 мин до 25 секунд. Но ! если я открываю файл как есть ни какой обработки не происходит.
Line Input #1, InputData в переменную залетает последние две строки файла.
Сделал коряво конечно но просто время жмет. Написал макрос в Ворде он открывает так же по циклу файлы логов и просто сохраняет их в тектовом формате.
После этого все идет нормально (по строчно ). Может я програмно не правильно открываю файл ?
Open MyFile For Input As FreeFile - вот тут ?

Добавлено @ 07:34
Прошу прощения за косяк , когда копировал строку с кода , видать запарился и вырезал
в коде где ремарк :

Код

Open MyFile For Input As FreeFile Do While Not EOF(1) Line Input #1, InputData   ' кидаем строку в переменную

еще раз извените за невнимательность !

FreeFile может вернуть не только #1, делай так

Код

Dim nFile As Long nFile = FreeFile Open MyFile For Input As nFile Line Input #nFile, InputData

как есть - это как?
Line Input #1, InputData в переменную залетает последние две строки файла - как именно последние две строки туда залитают?
замени Workbooks("BSS222_Diagram").Worksheets("Import") на переменную, быстрее работать будет.

Код

Dim WorksH As Excel.Worksheet Set WorksH = Workbooks("BSS222_Diagram").Worksheets("Import")

Цитата

как есть - это как?

Как есть т.е. файл взятый по FTP сервера Unix
Да я сам честно говоря не мойму почему так .
Vach лучше один раз увидеть. Куда тебе скинуть лог файл ?
Кстати так как ты сказал тоже результата не дало (((

Код

Dim nFile As Long nFile = FreeFile Open MyFile For Input As nFile Line Input #nFile, InputData

Alles, если я правильно помню, то на UNIX-е знак новой строки не такой как в винде.
Возможно из за этого Line Input не так работает.

Может быть я не буду спорить , но когда эту хрень ( пардон за ругательство ) открываешь Вордом и просто сохраняешь в тхт все идет нормально т.е. фай разбивается по строкам.

Alles, это подтверждает мое подозрение.
Надо посмотреть на файл в бинарном/HEX виде, и посмотреть какие символы у него в конце строки.

Alles файлы пришли, буду смотреть.

Это сообщение отредактировал(а) Vach - 16.11.2004, 15:54

Да , там стоит перенос , но какова хрена он не переносит я не знаю ))
Ворд показал наличие переноса после значения каждого параметра и еще точки вместо пробелов .
Добавлено @ 15:52
Hi Vach !
все должно быть у тебя

Alles, что значит перенос? Какой ASCII код?
Line Input читает строку до ASCII кода 13 или (13 и 10)
Добавлено @ 15:55
А может стоит весь файл целиком прочитать в стринговую переменную, поделить split-ом на строки и уже работать с готовым массивом строк.

Hi boevik !
большое спасибо за участие !!!
может тебе тоже лог кинуть и сам тогда все увидишь

Alles, кидай. [email protected]

Hi boevik !
файлы у тебя

Вот так вроде работает.

Код

Dim File_Name As String Dim Bytes() As Byte Dim fNum As Long Dim File_Length As Long File_Name = App.Path & "\BSCmevent.1115040015.tmp" File_Length = FileLen(File_Name) fNum = FreeFile ReDim Bytes(1 To File_Length) Open File_Name For Binary As #fNum Get #fNum, 1, Bytes Close fNum Dim sText As String Dim nF1 As Long sText = String(File_Length, " ") For nF1 = 1 To File_Length    Mid$(sText, nF1, 1) = Chr$(Bytes(nF1))    Next nF1 sText = Replace(sText, Chr$(10), vbCrLf, 1, -1, vbBinaryCompare) sText = Replace(sText, "  ", " ", 1, -1, vbBinaryCompare) sText = Replace(sText, "  ", " ", 1, -1, vbBinaryCompare) sText = Replace(sText, "  ", " ", 1, -1, vbBinaryCompare) Dim BTS_DATA_RECORD() As String Dim BTS_DATA_RECORD_Row() As String Dim BTS_DATA_RECORD_Header() As String BTS_DATA_RECORD = Split(sText, "BTS_DATA_RECORD", -1, vbBinaryCompare) For nF1 = 1 To UBound(BTS_DATA_RECORD)    BTS_DATA_RECORD_Row = Split(BTS_DATA_RECORD(nF1), vbCrLf, -1, vbBinaryCompare)    BTS_DATA_RECORD_Header = Split(BTS_DATA_RECORD_Row(0), " ", -1, vbBinaryCompare)    ' ...    ' Тут все и считай    ' ...    Next nF1

Это сообщение отредактировал(а) Vach - 16.11.2004, 17:07

Alles, так и есть. Символ разделения строк в файле имеет код 10, поэтому Line Input его игнорировал.


Vach, тебе уже подсказал код.
Но если не боишься использовать дополнительные библиотеки (Microsoft Scripting Runtime), то вот код:

Код

Dim File_Name As String Dim oFSO As New FileSystemObject Dim sFile As String Dim sLines() As String File_Name = "c:\temp\1.txt" sFile = oFSO.OpenTextFile(File_Name).ReadAll sLines = Split(sFile, Chr(10)) ' a дальше цикл для обработки строк ....

Это сообщение отредактировал(а) boevik - 16.11.2004, 16:52

Мужики !!!!!!!!!!!!!!!!!!!!!!
боооольшое спасибо !!!!!!!!!!!!
сегодня у нас уже поздновато тут на севере.
Завтра все попробую. Еще раз боольшое спасибо за участие.
с меня ящик коньяку !!!!!!!!!!!!!!!!!!!!!!!!!!!!

на моей машине "Microsoft Scripting Runtime" быстрее на 25% при файле в 6.5мб
Так всяко лучше.

Код

Dim nF1 As Integer Dim File_Name As String Dim oFSO As New FileSystemObject Dim sText As String Dim BTS_DATA_RECORD() As String Dim BTS_DATA_RECORD_Row() As String Dim BTS_DATA_RECORD_Header() As String File_Name = App.Path & "\BSCmevent.1115040015.tmp" sText = oFSO.OpenTextFile(File_Name).ReadAll sText = Replace(sText, Chr$(10), vbCrLf, 1, -1, vbBinaryCompare) sText = Replace(sText, "  ", " ", 1, -1, vbBinaryCompare) sText = Replace(sText, "  ", " ", 1, -1, vbBinaryCompare) sText = Replace(sText, "  ", " ", 1, -1, vbBinaryCompare) BTS_DATA_RECORD = Split(sText, "BTS_DATA_RECORD", -1, vbBinaryCompare) For nF1 = 1 To UBound(BTS_DATA_RECORD)    BTS_DATA_RECORD_Row = Split(BTS_DATA_RECORD(nF1), vbCrLf, -1, vbBinaryCompare)    BTS_DATA_RECORD_Header = Split(BTS_DATA_RECORD_Row(0), " ", -1, vbBinaryCompare)    ' ...    ' Тут все и считай    ' ...    Next nF1

Еще раз всем привет !
Вы уж простите меня тупорылого , но результат остался тот же !!!(((((

Код

File_Name = ListBox2 sText = oFSO.OpenTextFile(File_Name).ReadAll Debug.Print sText ' В переменную залетает последние две строки

Задача стоит такая, когда я открываю лог-файл я должен его пробежать по строчно.
Ключевые строки в логе это :

Цитата

BTS_DATA_RECORD      2004-11-16 00:30:00  2004-11-16 00:45:00  TurboMAX_BSPLUS.TurboMAX_BSPLUS_bts_0-Cel  20100  1

.
Для меня тут важно:
20100 - устройство (всего их 5 - 20100,20200,10100,10200,10300)
00:30 - время записи
и дальше идут параметры со значениями данного устройсва. Дальше пошел цикл на интересуещие меня параметры их пока 19. т.е. я пробегаю по файлу 19 раз.
Все скидывается на лист Impotr, где :
Параметр_____Заначение______Время______Устройство
Когда лог сохранен в тхт все идет просто здорово. т.е. просто открываю его Вордом и жму сохранить, ВСЕ!!! проблем нет все читается по строчно ( уже в программе) , но когда я открываю его как есть опять повторюсь

Цитата

' В переменную залетает последние две строки

т.е. небольшой кусок от 10200 начиная с параметра ARCmServAbt = 0
и до конца файла все залетает скопом.
И как с этим бороться я не знаю ((((

Alles, привет.

Код

Dim File_Name As String Dim oFSO As New FileSystemObject Dim sFile As String Dim sLines() As String File_Name = "c:\temp\1.txt" sText = oFSO.OpenTextFile(File_Name).ReadAll sLines = Split(sFile, Chr(10)) ' a дальше цикл для обработки строк ....

После того как ты считал данные в sText, надо разбить их на строки командой Split.
И уже пробегать по sLines()

Это все понятно !
Но почему только данные берутся только конечные ?
Не сначала файла , а просто последний кусок !!!

Alles, я не понимяю о чем ты. У меня считывается весь файл.
Добавлено @ 08:39
Показывай код.

У меня короче уже башню рвет.
Немного по позже, лишнее повыкидываю и если хочешь метну к тебе.

Код

Debug.Print Len(sText)

Сравни длину sText с размером файла.
У меня байт в байт, всегда.
Если есть разница, ищи ошибку в другом месте.

ВСЕ !!!!!!!!!!!!!!
УРА !!!!!!!!!!!!!!
Работает все в лет !!!!!
Всем С П А С И Б О !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!