Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Пользователи » Илья Аганичев
Выбрать дату в календаре…Выбрать дату в календаре

Страницы: 1
Помогите распарсить текстовый (с тегами) файл 2МБ(110000строк)
 
#
17.12.2010 07:55:21
в тексте есть  
...  
<NormalColor>0</NormalColor>  
<ToolTip>ГЛАВНАЯ</ToolTip>  
<Body>1. bla-bla-bla-bla  
2. bla-bla-bla-bla  
3. bla-bla-bla-bla-bla</Body>  
<NormalColor>0</NormalColor>  
...  
<Body>Инструкция по установке программы  
bla-bla-bla-bla</Body>  
<NormalColor>16711680</NormalColor>  
<Body>Прочитать файл INFO</Body>  
<ToolTip>bla-bla-bla-bla</ToolTip>  
<NormalColor>0</NormalColor>  
Нужно вынуть в отд. файл (например,TXT) все теги <body> предваряя их вывод номером строки исходника, где встретился тег, а в другой файл - теги <tooltip>  
хелп по XML какой-то непрозрачный для моего понимания
 
Перейти    
Значок СВЕРНУТЬ ФОРМУ
 
#
02.12.2008 08:34:43
а то можно подумать, что в моем
 
Перейти    
Значок СВЕРНУТЬ ФОРМУ
 
#
02.12.2008 08:24:18
только из неумения обращаться к windows-апплетам  
В примере же клевое использование winapi. Как раз, как в ТЗ
 
Перейти    
Значок СВЕРНУТЬ ФОРМУ
 
#
01.12.2008 13:51:22
я перепутал  
тогда остается пользоваться вспомогательной формой для открытия (восстановления) "спрятанной" формы, или динамически, на стандартной панели инструментов создавать кнопку востановления с прикрепленным макросом, показывающим "спрятанную" форму.
 
Перейти    
FormulaR1C1 в цикле For To
 
#
01.12.2008 13:34:12
конечно "i=0" из строки с Dim нужно удалить  
вообще-то, тот же паровоз, только вид сбоку, однако оперировать ссылками вида "А1" несколько привычнее, чем R1C1.
 
Перейти    
FormulaR1C1 в цикле For To
 
#
01.12.2008 13:30:38
Sub Корреллограмма()  
   Dim i As Single    i = 0  
   For i = 1 To 189  
       Range("b" + CStr(i)).Formula = "=correl(A" + CStr(i + 1) + ":$A$190,$A$1:A" + CStr(190 - i) + ")"  
   Next i  
End Sub
 
Перейти    
Значок СВЕРНУТЬ ФОРМУ
 
#
01.12.2008 08:58:44
для сворачивания формы (если конечно не отменено в ее свойствах) есть стандартная кнопка в заголовке окна. Модально открытую форму свертывать смысла нет. Для немодальных форм можно создать кнопку с действием me.hide, но на другой форме, доступной в этот момент, должна быть кнопка с    
userform(та, что спрятана).show  
может что и упустил... уважаемое сообщество добавит - поправит
 
Перейти    
подскажите, как остановить выполнение процедуры, метода
 
#
01.12.2008 08:51:35
действительно, что-то я переборщил в этот раз.. все под молодого "кошу"...  
э-эх...
 
Перейти    
CommandButton-анимация
 
#
01.12.2008 08:37:07
ни GIF, ни флэш...    
по-моему баловство это  
и так после серфинга в глазах рябит (и ведь плагины не всегда получается отключать, некоторые уже все меню на флэш делают и с отключенными плагинами ащще ничего не видно...а инет у нас лимитирован)
 
Перейти    
TextBox, как задать ему определённый формат на ввод данных????
 
#
01.12.2008 07:53:33
в бесконечный цикл не попадем. удаляя неправильно введеный символ, мы же изменяем поле, вот и вызывается опять эта же процедура. Но т.к. предыдущий символ не м.б. "неправильным", там фся рекурсия и заканчивется.
 
Перейти    
TextBox, как задать ему определённый формат на ввод данных????
 
#
01.12.2008 07:28:26
надо же ставить условие на пусто  
рабочий код вот такой  
 
Private Sub TextBox1_Change()  
If Len(TextBox1) > 0 Then  
   lc = Right(TextBox1, 1)  
   If lc < "0" Or lc > "9" Then TextBox1 = Left(TextBox1, Len(TextBox1) - 1)  
End If  
End Sub  
 
этот код я проверил. оне (букаффки) конечно должны появляццо, тока у мну машина быстрая и я не успевал их заметить...  :)  
зы  только вот дробные значения не получится проверять, хотя где-то в "закромах" моего personal.xls лежит и такая
 
Перейти    
преобразовать таблицу столбцов в одну строку с содержимым столбцов
 
#
01.12.2008 06:41:56
{quote}{login=sergenbal}{date=28.11.2008 04:07}{thema=Re: можно так}{post}ГЕНИАЛЬНО!!!  
Работает!  
Спасибо Вам огроменное!{/post}{/quote}да нет, конечно, не гениально  
мне не надо было привлекать методику "копировать-вставить", просто присвоить значения ячейкам. К тому же, исходная инфа должна быть осортирована по кодам операторов. Кроме того, как доказывает уважаемый vikttur, можно обойтись вообще без VBA. Правда не ясно, что делать в случае пополнения исходной таблицы, т.к. Лист "Результат" не изменяется никак; в моем же случае достаточно перезапустить макрос отчета. Однако, в любом случае, квалификация vikttur вызывает восхощение. Столь нетривиальный подход...
 
Перейти    
преобразовать таблицу столбцов в одну строку с содержимым столбцов
 
#
28.11.2008 14:11:48
Sub report()  
Dim rp As Worksheet, src As Worksheet  
Set src = ActiveWorkbook.ActiveSheet  
Workbooks.Add  
Application.ScreenUpdating = False  
Set rp = ActiveWorkbook.ActiveSheet  
cr = 1: lr = 1: step = 1  
src.Activate  
i = 1: cc = Cells(1, 1): oc = Cells(1, 1)  
Range("a1:d1").Select: Selection.Copy  
rp.Activate: Cells(1, 1).Select  
ActiveSheet.Paste  
Do While src.Cells(i, 1) <> ""  
   i = i + 1: cl = CStr(i): cc = src.Cells(i, 1)  
   If oc <> cc Then  
       src.Activate  
       oc = cc: lr = lr + 1: cr = lr: step = 1  
       Range("a" + cl + ":d" + cl).Select: Selection.Copy  
       rp.Activate: Cells(lr, 1).Select  
      Else  
       src.Activate  
       Range("c" + cl + ":d" + cl).Select: Selection.Copy  
       rp.Activate: Cells(cr, step * 2 + 3).Select: step = step + 1  
   End If  
   ActiveSheet.Paste  
Loop  
Application.ScreenUpdating = True  
End Sub  
 
запускать макрос с листа, несущего исходные данные.  
данные без заголовков  
выполняется до первой пустой строки в колонке А. Открывает новую книгу и сует туда все, как Вы просили
 
Перейти    
помогите блондинке, а то уволят
 
#
28.11.2008 10:34:10
в ячейке, где будет сумма по "День" ффтыкаем формулу  
 
=СУММЕСЛИ(C:C;<признак>;B:B)  
 
вместо <признак> вставите Ваш реальное значение, соотвествующее, например, дню.  
соответственно, для остальных признаков занимаете подобной формулой другие ячейки, в формуле маняется только "признак"  
 
успехафф
 
Перейти    
TextBox, как задать ему определённый формат на ввод данных????
 
#
28.11.2008 09:53:30
вот опять знак забыл    
вот как надо  
 
Private Sub TextBox1_Change()  
If Len(TextBox1) > 0 Then  
   lc = Right(TextBox1, 1)  
   If lc < "0" Or lc > "9" Then TextBox1 = Left(TextBox1, Len(TextBox1) - 1)  
End If  
End Sub  
 
ну и проверку на диапазон при выходе
 
Перейти    
TextBox, как задать ему определённый формат на ввод данных????
 
#
28.11.2008 09:48:18
при использовании события change брать последний введенный символ. Елси подходит оставлять его, если нет - присваивать полю последнее значение  
 
Private Sub TextBox1_Change()  
   lc = Right(TextBox1, 1)  
   If lc < "0" And lc  "9") Then TextBox1 = Left(TextBox1, Len(TextBox1) - 1)  
End Sub  
 
при таком методе фсякие знаки, кроме цифр, в поле ввода даже не появляюцца!  :)
 
Перейти    
TextBox, как задать ему определённый формат на ввод данных????
 
#
28.11.2008 06:53:38
размер архива 7кб (это для тех у кого трафик платный)
 
Перейти    
TextBox, как задать ему определённый формат на ввод данных????
 
#
28.11.2008 06:51:44
стоит принуждение к объявлению переменных.  
Я приложил файлик (с автозапуском), попробуйте... У меня не ругаецца
 
Перейти    
Макрос на открытие последнего созданного файла из определенной папки.
 
#
28.11.2008 06:33:28
Уважаемый Лузер™ прав, чиво-то я загнул с объектом FileSystem! Лишку это...  
тогда код упрощаецца:  
Function last_open(pt, wc) As String  
Dim fs As FileSearch  
Dim lad As Date, cad As Date  
cad = CDate("1/1/1980")  
With Application.FileSearch  
   .NewSearch  
   .LookIn = pt  
   .SearchSubFolders = False  
   .Filename = wc  
   .MatchTextExactly = False  
   .FileType = msoFileTypeExcelWorkbooks  
End With  
With Application.FileSearch  
   If .Execute() > 0 Then  
       For i = 1 To .FoundFiles.Count  
           lad = FileDateTime(.FoundFiles(i))  
           If lad > cad Then  
               cad = lad: fn = .FoundFiles(i)  
           End If  
       Next i  
       last_open = fn  
   Else  
       MsgBox "В папке " & pt & "XLS файлов не найдено"  
   End If  
End With  
End Function  
 
Правда получился не намного проще, но все-таки отринут целый метод...
 
Перейти    
подскажите, как остановить выполнение процедуры, метода
 
#
27.11.2008 13:37:23
в тормозимый sub 1 (там фсиравно есть цикл) ф тело цикла ффтыкал глобальную boolean переменную, например gogogo, дойдя до ее проверки sub 1 мог прерваццо (if not gogogo then exit sub). в другом sube 2 по мере надобности эту переменную выключал и sub 1 вылетал.  
:)
 
Перейти    
TextBox, как задать ему определённый формат на ввод данных????
 
#
27.11.2008 13:25:50
вывод:  
вводить в поле интервал в секундах, геморно юзеру набирать 00:00:15, особенно если русский язык стоит  
использовать для поля событие exit  
проверить введенное значение на соотвествие и пропустить или поставить дефолтное значение  
 
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)  
If Val(TextBox1) > 10 And Val(TextBox1) < 10000 Then  
 Else  
   TextBox1 = 20 ' default value  
End If  
End Sub
 
Перейти    
Макрос на открытие последнего созданного файла из определенной папки.
 
#
27.11.2008 12:45:13
да не такой уж и сложный... берете его целиком и юзаете. В конечном итоге Вам нужно имя файла из указанной папки, что Вы и получаете. Не Вы же лично исполняете код функции а комп.  
Команды DIR в VBA нету, ее ближайший аналог filesearch.execute с предварительно установленными парметрами поиска  
доступ к атрибутам файла только через Scripting.FileSystemObject  
 
Другое дело, что медленновато может быть. Так файловые операции, особенно сетевые всегда медленнее работы с памятью... Заголовок функцию можно слегка модифицировать, введя еще один параметр со смыслом wildcard. Т.е. вызов ее такой будет  
 
...  
имя_файла_для_открытия=last_open("где искать(путь)","26.11.2008*.xls")  
...  
тогда в указанном пути будут просмотрены только xls-файлы содержащие в имени 26.11.2008  
 
 
function last_open(pr,wc)  
...  
.filename=wc  ' 9-я строка  
...
 
Перейти    
Уважаемые, про сопоставление двух ячеек
 
#
27.11.2008 12:08:37
соответственно переменные первая_колонка и вторая_колонка обозначают, из какой ячейки брать оригинал и с какой сравнивать соотвественно. когда "a" становится true (найдено совпадение), то в этот момент: i - номер строки, j - номер стартовой позиции поискового паттерна в исходной ячейке, совп - совпавший паттерн.  
Как-то так...  
Успехаф
 
Перейти    
Уважаемые, про сопоставление двух ячеек
 
#
27.11.2008 12:01:48
For i = начальная_строка To конечная_строка  
  перв_яч = Cells(i, первая_колонка)  
  For j = 1 To Len(перв_яч - 5)  
      совп = Mid(перв_яч, j, 5)  
      a = Cells(i, вторая_колонка).Find(What:=совп, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _  
       xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _  
       , SearchFormat:=False).Activate  
       If a Then  
           Rows(i).Select  
           With Selection.Interior  
               .ColorIndex = 6  
               .Pattern = xlSolid  
           End With  
       End If  
  Next  
Next  
 
этот фрагмент раскрасит всю строку в желтый цвет, если в ячейке второй_колонки есть пять идущих подряд символов из первой_колонки, начиная с любой позиции.  
переменные начальная_строка и конечная_строка инициируйте нужными значениями
 
Перейти    
Макрос на открытие последнего созданного файла из определенной папки.
 
#
27.11.2008 11:34:33
У мну получилось в виде функции с аргументом "Папка"  
возвращает полное имя файла, с максимальной датой последнего ИЗМЕНЕНИЯ  
 
Function last_open(pt) As String  
Dim fs As FileSearch  
Dim lad As Date, cad As Date  
cad = CDate("1/1/1980")  
With Application.FileSearch  
   .NewSearch  
   .LookIn = pt  
   .SearchSubFolders = False  
   .Filename = "*.xls"  
   .MatchTextExactly = False  
   .FileType = msoFileTypeExcelWorkbooks  
End With  
 
With Application.FileSearch  
   If .Execute() > 0 Then  
       Set fs1 = CreateObject("Scripting.FileSystemObject")  
       For i = 1 To .FoundFiles.Count  
           Set f = fs1.GetFile(.FoundFiles(i))  
           lad = CDate(f.DateLastModified)  
           If lad > cad Then  
               cad = lad: fn = .FoundFiles(i)  
           End If  
       Next i  
       last_open = fn  
   Else  
       MsgBox "В папке " & pt & "XLS файлов не найдено"  
       last_open=""  
   End If  
End With  
End Function
 
Перейти    
Страницы: 1
Наверх