/ КОМПЬЮТЕРЫ И ПО / Языки программирования / Basic/VBA

Выпуск № 754
от 14.04.2008, 15:35

Вопрос № 131.319

Возможно ли отключить в Word функцию создания временных файлов? В решаемой задаче из LabVIEW происходит запись данных в Word с применением технологии ActiveX. Функция Save отрабатывается после каждой операции помещения данных в Word. В результате за 1 минуту может быть создано огромное количество временных файлов. Спасибо

Отправлен: 09.04.2008, 13:24 Вопрос задал: Sergeichenko Aleksey (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 0)

Отвечает: Черников Игорь Владимирович Здравствуйте, Sergeichenko Aleksey! попробуйте везде поставить False With Options .LocalNetworkFile = False .AllowFastSave = False .BackgroundSave = True .CreateBackup = False .SavePropertiesPrompt = False .SaveInterval = 10 .SaveNormalPrompt = False .DisableFeaturesbyDefault = False End With With ActiveDocument .ReadOnlyRecommended = False .EmbedTrueTypeFonts = False .SaveFormsData = False .SaveSubsetFonts = False .DoNotEmbedSystemFonts = True .Password = "" .WritePassword = "" .DisableFeatures = False .EmbedSmartTags = False .SmartTagsAsXMLProps = False .EmbedLinguisticData = False End With --------- От каждого по способностям, каждому по труду

Ответ отправил: Черников Игорь Владимирович (статус: 10-ый класс) Ответ отправлен: 09.04.2008, 17:01

Отвечает: Архипов Александр Леонидович Здравствуйте, Sergeichenko Aleksey! Сервис-Параметры... Вкладка "Сохранение" Убираете ненужные галки...

Ответ отправил: Архипов Александр Леонидович (статус: Студент) Ответ отправлен: 10.04.2008, 06:07

Вопрос № 131.342

Программа на VB6 делает аназиз текстовой информации. Имеется два массива слов (до 100 000 элементов в каждом) Нужно выбрать из первого массива только те слова, которые НЕ встречаются во втором массиве. Используемый мною тупой алгоритм сравнения всех со всеми выдает результат через несколько часов. Мне подсказали, что при использовании SQL-запроса это можно делать за считаные секунды. Поэтому два вопроса: 1. Как массив "преобразовать" в базу данных 2. как правильно написать SQL-запрос в данной ситуации.

Отправлен: 09.04.2008, 14:53 Вопрос задал: Perkussi (статус: Посетитель) Всего ответов: 2 Мини-форум вопроса >>> (сообщений: 2)

Отвечает: HookEst Здравствуйте, Perkussi! а почему "при использовании SQL-запроса это можно делать за считаные секунды"? потому что в DB мы можем создать индексное поле и осуществлять поиск по нему(а без индекса и через SQL - это будет также "тупой алгоритм сравнения всех со всеми "). А что такое индекс? это какое-то упорядочивание данных. Так мы и без DB можем отсортировать массивы, а поиск по сортированным массивам и вручную будет делом "считанных секунд". Я не стал использовать DB(если Евгений Алексеевич сделает, было бы очень интересно сравнить), а предлагаю свои два метода фильтрации. первый с помощью сортировки, а второй с использованием, уже ставшего мне любимым)), Collection. в приложении, небольшой тестик для сравнения этих методов для 100 000 слов(каждое слово длиной 10 букв) метод с сортировкой занял ~ 9.2 сек, из которых 8,5 сек ушло на сортровку, все остальное на фильтрацию а метод с использование Collection занял ~2.3 сек. т.к. слова я формировал случайным образом(всего из нескольких различных символов, чтобы хоть какието совпадения находились), код не оптимизировал, и готовил сразу 2 массива с результатом(в первом все значения из первого массива, которые есть во втором массиве, а во втором - те значения которых нет во втором массиве), то конечно результаты очень примерные, но все же не несколько часов. а может напутал чего)) Успехов. Приложение: Option Explicit Private Declare Function mTime Lib "winmm.dll" Alias "timeGetTime" () As Long Const ARRAY_SIZE = 100000 Const WORD_LEN = 10 Sub test() Dim Arr1 Dim Arr2 Dim Exists Dim NotExists Dim t As Long Randomize Debug.Print "Creating arrays:" t = mTime Arr1 = CreateArray(ARRAY_SIZE) Arr2 = CreateArray(ARRAY_SIZE) Debug.Print mTime - t; " ms" Debug.Print "Filtering with Collection:" t = mTime Filter2 Arr1, Arr2, Exists, NotExists Debug.Print mTime - t; " ms" Debug.Print "Filtering with Sort:" t = mTime Filter1 Arr1, Arr2, Exists, NotExists Debug.Print mTime - t; " ms" Debug.Print "Checking:" t = mTime Check Arr1, Arr2, Exists, NotExists Debug.Print mTime - t; " ms" End Sub 'push value to array Sub Push(arr, ByVal val As String) On Error GoTo Err_ ReDim Preserve arr(UBound(arr) + 1) As String arr(UBound(arr)) = val Exit Sub Err_: ReDim arr(0) As String Resume Next End Sub 'return count of array Function Count(arr) As Long On Error Resume Next Count = UBound(arr) - LBound(arr) + 1 End Function 'filter with sort Sub Filter1(Arr1, Arr2, Exists, NotExists) Dim e Dim ne Dim i1 As Long Dim i2 As Long Dim t As Long t = mTime Debug.Print Tab; "Sorting" ShellSortString Arr1 ShellSortString Arr2 Debug.Print Tab; mTime - t; " ms" t = mTime Debug.Print Tab; "Parsing" i1 = LBound(Arr1) i2 = LBound(Arr2) For i1 = LBound(Arr1) To UBound(Arr1) If Arr1(i1) > Arr2(i2) Then 'значение Arr1(i1) если есть в Arr2, то может лежать только где-то дальше в Arr(2), спускаемся For i2 = i2 To UBound(Arr2) - 1 If Not Arr1(i1) > Arr2(i2) Then Exit For Next i2 End If If Arr1(i1) > Arr2(i2) Then 'возможно только если спустились в самый низ Arr2 Push ne, Arr1(i1) ElseIf Arr1(i1) < Arr2(i2) Then 'значение Arr1(i1) не может быть дальше в Arr(2) Push ne, Arr1(i1) ElseIf Arr1(i1) = Arr2(i2) Then 'значение существует Push e, Arr1(i1) End If Next i1 Exists = IIf(IsEmpty(e), Array(), e) NotExists = IIf(IsEmpty(ne), Array(), ne) Debug.Print Tab; mTime - t; " ms" End Sub Sub Filter2(Arr1, Arr2, Exists, NotExists) Dim i As Long, j As Long, t As Long Dim c As New Collection Dim e, ne Debug.Print Tab; "fill collection:" On Error Resume Next t = mTime For i = LBound(Arr2) To UBound(Arr2) c.Add vbEmpty, Arr2(i) Next i Debug.Print Tab; mTime - t; " ms" Debug.Print Tab; "Parsing:" On Error GoTo ExistsErr t = mTime For i = LBound(Arr1) To UBound(Arr1) c.Add vbEmpty, Arr1(i) 'если добавилось без ошибок, значит этого значения в Arr2 - нет Push ne, Arr1(i) 'и удаляем то что добавили c.Remove Arr1(i) ExistsSkip: Next i Exists = IIf(IsEmpty(e), Array(), e) NotExists = IIf(IsEmpty(ne), Array(), ne) Debug.Print Tab; mTime - t; " ms" Exit Sub ExistsErr: 'если возникла ошибка, значит значение есть, удалять не нужно Push e, Arr1(i) Resume ExistsSkip End Sub 'сортирует массив строк методом Шелла(откуда взял, уже не помню) Sub ShellSortString(vArray As Variant) Dim lLoop1 As Long Dim lHold As Long Dim lHValue As Long Dim lTemp As String lHValue = LBound(vArray) Do lHValue = 3 * lHValue + 1 Loop Until lHValue > UBound(vArray) Do lHValue = lHValue / 3 For lLoop1 = lHValue + LBound(vArray) To UBound(vArray) lTemp = vArray(lLoop1) lHold = lLoop1 Do While vArray(lHold - lHValue) > lTemp vArray(lHold) = vArray(lHold - lHValue) lHold = lHold - lHValue If lHold < lHValue Then Exit Do Loop vArray(lHold) = lTemp Next lLoop1 Loop Until lHValue = LBound(vArray) End Sub 'заполняет массив случайными строками Function CreateArray(ByVal Count As Long) Dim i As Long, j As Long Dim a ReDim a(Count) As String For i = 0 To Count For j = 0 To WORD_LEN a(i) = a(i) & Chr(Rnd * 2 + 65) Next j Next i CreateArray = a End Function Sub Check(Arr1, Arr2, Exists, NotExists) Dim i As Long, j As Long, t As Long Dim c As New Collection Debug.Print Tab; "len Checking:" If Count(Exists) + Count(NotExists) <> Count(Arr1) Then Debug.Print Tab; Tab; "len check Failed!" Debug.Print Tab; "fill collection:" On Error Resume Next t = mTime For i = LBound(Arr2) To UBound(Arr2) c.Add vbEmpty, Arr2(i) Next i Debug.Print Tab; mTime - t; " ms" Debug.Print Tab; "Checking Exists:" On Error GoTo ExistsErr t = mTime For i = LBound(Exists) To UBound(Exists) c.Add vbEmpty, Exists(i) Debug.Print Tab; Tab; "exists check Failed! "; Exists(i); " not in Arr2!" c.Remove Exists(i) ExistsSkip: Next i Debug.Print Tab; mTime - t; " ms" Debug.Print Tab; "Checking NotExists:" On Error GoTo NotExistsErr t = mTime For i = LBound(NotExists) To UBound(NotExists) c.Add vbEmpty, NotExists(i) c.Remove NotExists(i) NotExistsSkip: Next i Debug.Print Tab; mTime - t; " ms" Exit Sub ExistsErr: Resume ExistsSkip NotExistsErr: Debug.Print Tab; Tab; "notexists check Failed! "; NotExists(i); " is in Arr2!" Resume NotExistsSkip End Sub

Ответ отправил: HookEst (статус: Специалист) Ответ отправлен: 11.04.2008, 13:11 Оценка за ответ: 4 Комментарий оценки: Очень подробный ответ. Пример с анализом скорости выполнения. Возможно так даже лучше будет работать, но вопрос был про базы данных и SQL-запрос....

Отвечает: Тесленко Евгений Алексеевич Здравствуйте, Perkussi! Я проверил утверждение "за считаные секунды...при использовании SQL-запроса" Подключил к базе данных два сгенерированых текстовых файла, в каждом по 100000 строк, создал запрос (его конструкция в приложении). я Вас огорчу, открывался запрос 35 секунд, а это не идет в сравнение с вариантом предложенным HookEst. С помощью его конструкции я проверил время при выполнении задачи с использованием рекордсета, результат значительно лучше чем с использованием SQL: Creating Recordset: 5032 ms Sorting Recordset: 971 ms Removing from Recordset: 1913 ms Count Record: 75360 Result Array: 1 ms Result Time: 7920 ms Решать Вам, но при таком количестве записей я бы не отдавал предпочтение SQL. Евгений. Приложение: конструкция запроса: SELECT Field1 FROM File2 RIGHT JOIN File1 ON File2.Field1 = File1.Field1 WHERE Field1 Is Null проверка с помощью ADO recordset: Sub test() Dim rs0 As New ADODB.Recordset Dim rs1 As New ADODB.Recordset Dim tSum&, i& t = mTime tSum = mTime Debug.Print "Creating Recordset:" CreateRecordset rs0, ARRAY_SIZE, "C:File1.txt" CreateRecordset rs1, ARRAY_SIZE, "C:File2.txt" Debug.Print mTime - t; " ms" t = mTime Debug.Print "Sorting Recordset:" sortRecordset rs0 sortRecordset rs1 Debug.Print mTime - t; " ms" t = mTime Debug.Print "Removing from Recordset:" i = removFromRecordset(rs0, rs1) Debug.Print mTime - t; " ms" Debug.Print "Count Record: "; i t = mTime Debug.Print "Result Array:" If Not rs0 Is Nothing And Not rs0.EOF Then rs0.MoveFirst resultArr rs0 Debug.Print mTime - t; " ms" Debug.Print "Result Time: " Debug.Print mTime - tSum; " ms" rs0.Close: rs1.Close End Sub 'заполняет рекорлсет случайными строками 'закоментированы строки создания файла для SQL Function CreateRecordset(rs As ADODB.Recordset, ByVal Count As Long, sFile$) Dim i&, j%, s$ 'Dim iFileNum% 'iFileNum = FreeFile 'Open sFile For Output As #iFileNum With rs .Fields.Append 0, 200, WORD_LEN .CursorLocation = adUseClient .Open For i = 0 To Count - 1 .AddNew Randomize s = Left("FFFFFF" & Rnd * 20, 10) 'Print #iFileNum, s .Fields(0) = s: s = Empty Next i End With 'Close #iFileNum End Function 'сортировка рекорлсета Sub sortRecordset(rs As ADODB.Recordset) rs.Sort = "0 ASC" rs.MoveFirst End Sub 'удаление при совпадении Function removFromRecordset(rs0 As ADODB.Recordset, rs1 As ADODB.Recordset) As Long Dim bIs As Boolean, i& 10: i = 0 Do Until rs0.EOF Do Until rs1.EOF If rs0(0) = rs1(0) Then rs0.Delete rs0.MoveFirst GoTo 10 End If rs1.MoveNext Loop i = i + 1 rs0.MoveNext Loop removFromRecordset = i If Not rs0.EOF Then rs0.MoveFirst End Function 'результирующий массив Sub resultArr(rs As ADODB.Recordset) Dim sArr() As String, i& ReDim sArr(rs.RecordCount) Do Until rs.EOF sArr(i) = rs(0) i = i + 1 rs.MoveNext Loop End Sub

Ответ отправил: Тесленко Евгений Алексеевич (статус: Студент) Ответ отправлен: 12.04.2008, 13:28 Оценка за ответ: 5 Комментарий оценки: Исчерпывающий ответ на поставленные вопросы. Приведен сравнительный анализ методов. P.S. а в программе я всё-же уже реализовал метод, предложенный HotEst, за что ему отдельное СПАСИБО!

© 2001-2008, Портал RusFAQ.ru, Россия, Москва. Авторское право: ООО "Мастер-Эксперт Про" Техподдержка портала, тел.: +7 (926) 535-23-31 Хостинг: "Московский хостер" Поддержка: "Московский дизайнер" Авторские права | Реклама на портале ∙ Версия системы: 4.91 pre 5.0 RC1 от 13.04.2008
RusFAQ.ru | MosHoster.ru | MosDesigner.ru | RusIRC.ru Kalashnikoff.ru | RadioLeader.ru | RusFUCK.ru