Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / оптимизация программного кода / 24 сообщений из 24, страница 1 из 1
19.06.2007, 08:59
    #34603551
fantomm
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
Вот мой код:

Private Sub CommandButton1_Click()
Set sh58 = ThisWorkbook.Sheets("58 счет")
Set sh76 = ThisWorkbook.Sheets("76 счет")
Set sh = ThisWorkbook.Sheets("Сравнения")

sh.Cells.Clear
sh.Cells(1, 1) = "Вексель"
sh.Cells(1, 2) = "Дебет 58"
sh.Cells(1, 3) = "Кредит 58"
sh.Cells(1, 4) = "Дебет 76"
sh.Cells(1, 5) = "Кредит 76"

l = 1
For i = 2 To 51568
txt58 = sh58.Cells(i, 1)
l0 = l
For k = 2 To 10139
txt76 = sh76.Cells(k, 1)
If txt58 = txt76 Then
l = l + 1
sh.Cells(l, 1) = txt58
sh.Cells(l, 2) = sh58.Cells(i, 2)
sh.Cells(l, 3) = sh58.Cells(i, 3)
sh.Cells(l, 4) = sh76.Cells(k, 2)
sh.Cells(l, 5) = sh76.Cells(k, 3)
Exit For
End If
Next k
If l0 = l Then sh58.Cells(i, 4) = "нет"
Next i

End Sub

Он сравнивает данные одного листа с данными другого. Совпадающие выносит на лист Совпадения, а те которые не совпадают то на листе 58 счет проставляет нет.

Данных на одном листе более 50000 строк, на другом более 10000.

Проблема в том, что это все очень долго обрабатывается.

Может кто подскажет как оптимизировать прогшраммный код, чтобы программа работала быстрее?
...
Рейтинг: 0 / 0
19.06.2007, 09:18
    #34603585
Программист Дёня
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
fantomm

А можно конкретный пример приложить, а то из кода ничего не ясно
...
Рейтинг: 0 / 0
19.06.2007, 09:25
    #34603595
klen_
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
в начале кода не помешает написать
Код: plaintext
    Application.ScreenUpdating = False
а в конце
Код: plaintext
    Application.ScreenUpdating = True
...
Рейтинг: 0 / 0
19.06.2007, 09:28
    #34603602
vkodor
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
Подстановка значений
Подстановка значений
поиск по форуму Find FindNext
...
Рейтинг: 0 / 0
19.06.2007, 10:22
    #34603746
fantomm
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
Программист Дёня fantomm

А можно конкретный пример приложить, а то из кода ничего не ясно

Конечно! Вот он!
...
Рейтинг: 0 / 0
19.06.2007, 10:22
    #34603748
fantomm
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
fantomm Программист Дёня fantomm

А можно конкретный пример приложить, а то из кода ничего не ясно

Конечно! Вот он!
...
Рейтинг: 0 / 0
19.06.2007, 10:53
    #34603909
TIKO
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
в вашем случае я бы посоветовал вам,
если форма эксель листа не объязательна то целесообразнее использовть эксель как бд
и проверять соответсвие через ADO+sql запрос
...
Рейтинг: 0 / 0
19.06.2007, 11:44
    #34604155
fantomm
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
TIKOв вашем случае я бы посоветовал вам,
если форма эксель листа не объязательна то целесообразнее использовть эксель как бд
и проверять соответсвие через ADO+sql запрос

Именно что форма эксель листа обязательна!
...
Рейтинг: 0 / 0
19.06.2007, 12:18
    #34604333
TIKO
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
такой вариант попробуйте
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
Private Sub CommandButton1_Click()
    Set sh58 = ThisWorkbook.Sheets("58 счет")
    Set sh76 = ThisWorkbook.Sheets("76 счет")
    Set sh = ThisWorkbook.Sheets("Сравнения")
    
    sh.Cells.Clear
sh.Cells( 1 ,  1 ) = "Вексель"
sh.Cells( 1 ,  2 ) = "Дебет 58"
sh.Cells( 1 ,  3 ) = "Кредит 58"
sh.Cells( 1 ,  4 ) = "Дебет 76"
sh.Cells( 1 ,  5 ) = "Кредит 76"


    
  l =  1 
    For i =  2  To  10139 
        txt58 = sh58.Cells(i,  1 )
           If GetShValue(sh58.Cells(i,  1 )) = True Then
                l = l +  1 
                sh.Cells(l,  1 ) = txt58
                sh.Cells(l,  2 ) = sh58.Cells(i,  2 )
                sh.Cells(l,  3 ) = sh58.Cells(i,  3 )
                sh.Cells(l,  4 ) = sh76.Cells(i,  2 )
                sh.Cells(l,  5 ) = sh76.Cells(i,  3 )
           Else
            sh58.Cells(i,  4 ) = "нет"
           End If
       
        
    Next i

End Sub


Function GetShValue(strValue As String) As Boolean
Dim f
Set f = Sheets("76 счет").Range("a1:a51568").Find(strValue, LookIn:=xlValues)
If Not f Is Nothing Then
    GetShValue = True
Else
    GetShValue = False
End If
Set f = Nothing
End Function
...
Рейтинг: 0 / 0
19.06.2007, 12:28
    #34604373
TIKO
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
+ условия на пустые значения
Код: plaintext
If GetShValue(sh58.Cells(i,  1 )) = True And Not IsEmpty(sh58.Cells(i,  1 )) = True Then
...
Рейтинг: 0 / 0
19.06.2007, 12:30
    #34604387
fantomm
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
TIKOтакой вариант попробуйте
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
Private Sub CommandButton1_Click()
    Set sh58 = ThisWorkbook.Sheets("58 счет")
    Set sh76 = ThisWorkbook.Sheets("76 счет")
    Set sh = ThisWorkbook.Sheets("Сравнения")
    
    sh.Cells.Clear
sh.Cells( 1 ,  1 ) = "Вексель"
sh.Cells( 1 ,  2 ) = "Дебет 58"
sh.Cells( 1 ,  3 ) = "Кредит 58"
sh.Cells( 1 ,  4 ) = "Дебет 76"
sh.Cells( 1 ,  5 ) = "Кредит 76"


    
  l =  1 
    For i =  2  To  10139 
        txt58 = sh58.Cells(i,  1 )
           If GetShValue(sh58.Cells(i,  1 )) = True Then
                l = l +  1 
                sh.Cells(l,  1 ) = txt58
                sh.Cells(l,  2 ) = sh58.Cells(i,  2 )
                sh.Cells(l,  3 ) = sh58.Cells(i,  3 )
                sh.Cells(l,  4 ) = sh76.Cells(i,  2 )
                sh.Cells(l,  5 ) = sh76.Cells(i,  3 )
           Else
            sh58.Cells(i,  4 ) = "нет"
           End If
       
        
    Next i

End Sub


Function GetShValue(strValue As String) As Boolean
Dim f
Set f = Sheets("76 счет").Range("a1:a51568").Find(strValue, LookIn:=xlValues)
If Not f Is Nothing Then
    GetShValue = True
Else
    GetShValue = False
End If
Set f = Nothing
End Function



Все так же долго работает, до сих пор не выполнилось!
...
Рейтинг: 0 / 0
19.06.2007, 12:44
    #34604452
fantomm
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
TIKO, с твоим кодом быстрее программа работает, но данных нашла гораздо меньше, а это не правильно!
...
Рейтинг: 0 / 0
19.06.2007, 12:48
    #34604467
TIKO
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
этот код на моей машине обрабатывает около 20 секунд при полном соответствии
двух кононок более 10000 совпадений, это по моему вполне бытрая обработка, по крайней мере один цикл на все
сколько на ваше машине идет обработка данного кода?
...
Рейтинг: 0 / 0
19.06.2007, 12:54
    #34604500
fantomm
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
TIKOэтот код на моей машине обрабатывает около 20 секунд при полном соответствии
двух кононок более 10000 совпадений, это по моему вполне бытрая обработка, по крайней мере один цикл на все
сколько на ваше машине идет обработка данного кода?
Около 15 - 20 минут.
Но я то имел в виду, что мой код выдавал более 4000 совпадений, а ваш всего около 2500.
Может мой не правильно работал?
...
Рейтинг: 0 / 0
19.06.2007, 13:10
    #34604573
PA
PA
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
fantomm TIKOэтот код на моей машине обрабатывает около 20 секунд при полном соответствии
двух кононок более 10000 совпадений, это по моему вполне бытрая обработка, по крайней мере один цикл на все
сколько на ваше машине идет обработка данного кода?
Около 15 - 20 минут.
Но я то имел в виду, что мой код выдавал более 4000 совпадений, а ваш всего около 2500.
Может мой не правильно работал?
У тебя:
Код: plaintext
For i =  2  To  51568 
У TIKO:
Код: plaintext
For i =  2  To  10139 
Т. е. цикл не по всем строкам проходит.
Я бы советовал всё-таки обратить внимание на ADODB, т.к. структура листов у тебя табличная, будет гораздо быстрее работать. Если надо, примерчик могу набросать...
...
Рейтинг: 0 / 0
19.06.2007, 13:15
    #34604586
TIKO
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
PA fantomm TIKOэтот код на моей машине обрабатывает около 20 секунд при полном соответствии
двух кононок более 10000 совпадений, это по моему вполне бытрая обработка, по крайней мере один цикл на все
сколько на ваше машине идет обработка данного кода?
Около 15 - 20 минут.
Но я то имел в виду, что мой код выдавал более 4000 совпадений, а ваш всего около 2500.
Может мой не правильно работал?
У тебя:
Код: plaintext
For i =  2  To  51568 
У TIKO:
Код: plaintext
For i =  2  To  10139 
Т. е. цикл не по всем строкам проходит.
Я бы советовал всё-таки обратить внимание на ADODB, т.к. структура листов у тебя табличная, будет гораздо быстрее работать. Если надо, примерчик могу набросать...

То РА точно перепутал
тогда Set f = Sheets("76 счет").Range("a1:a10139").Find(strValue, LookIn:=xlValues)
...
Рейтинг: 0 / 0
19.06.2007, 13:32
    #34604677
fantomm
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
TIKO, действительно быстрее работает!
Посмотрим результат, как доделает!
...
Рейтинг: 0 / 0
19.06.2007, 15:05
    #34605078
VladConn
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
Быстрее всего должен сработать подход с ADO/XML.

Посмотрите мой пример:

http://www.sql.ru/forum/actualthread.aspx?tid=412817

В вашем случае надо будет, видимо, в первую очередь, написать свой SQL запрос, достаточно простой, вместо того, что в примере.
...
Рейтинг: 0 / 0
19.06.2007, 17:56
    #34605822
ZeusTheTrueGod
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
Чтобы быстро решить такую задачу, необходимо поменять алгоритм сравнения двух массивов
Для примера, представьте, что вам надо сравнить 2 массива, и найти совпадающие(отсутствующие) элементы
(3 7 22 -4 34 2) и (-60 33 -2 22 1). У вас написана 2 цикла - сравнить каждый с каждым.
Если в первой последовательноти М, а во второй Н элементов, то всег М умножить на Н сравнений,
что очень долго для VBA.
Теперь попробуйте сравнить отсортированные последовательности
(-4 2 3 7 22 34) и (-60 -2 1 22 33). В этом случае не надо сравнивать каждый с каждым -
надо последовательно пройти каждый элемент один раз, в данном случае
1) сравниваем -60 и -4 как первые элементы - они не совпадают
2) так как -60 меньше чем -4, то выбираем следующий элемент из второй последовательности -2
3) Сравниваем -2 и -4. Теперь -4 меньше чем -2, и поэтому выбираем следующий элемент из первой поледовательноти 2
4) Сравниваем 2 и -2. Теперь -2 меньше чем 2, так что следующей элемент берем из второй последовательности 1
5) Сравниваем 1 и 2. Так как 1 меньше 2, то берем следующий элемент из второй последовательности 22
6) Сравниваем 22 и 2. Так как 2 меньше 22, то берем следующий из первой
7) 22 и 3
8) 22 и 7
9) 22 и 22. Теперь результаты совпали. Тут вопрос, могут ли в последовательности быть повторяющиеся значения. Будем считать что нет, но в любом случае берем следующие значения из обеих последовательностей
10) 22 и 33
11) 33 и 34
Как видно, в таком случае каждый элемент проверяется только один раз, и требуется М + Н проверок

если м 50000 н 10000 то вы проводили 500 000 000 проверок, а я же предлагаю 60 000, и на сортировку потребуетя то же какое то время, можете проверить сколько именно.
Ну и само собой, день потребуется вам на программирование.

Так что успехов в программировании эффективных алгоритмов
...
Рейтинг: 0 / 0
19.06.2007, 18:03
    #34605846
ZeusTheTrueGod
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
По поводу копирования не только номера векселя, но и дебита , кредита ...

Прежде всего я бы завел два новых листа с копиями вашего первого и второго листов и отортировал бы каждый из литов по векселю помощью метода sort или еще какой нибудь встроенной в эксель функцией, главное не писать сортировку самому


Потом уже сделать сравнение по указанному в предыдущем моем ответе алгоритму(кстати, это не я его придумал, он используется в сортировке слиянием).

Наконец, вопрос, как вернуть исходный порядок счетов в листе сравнения... это несколько по сложнее, но тем не менее тоже решается достаточно легко.
...
Рейтинг: 0 / 0
19.06.2007, 18:05
    #34605851
PA
PA
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
Решил проверит вариант с ADO:
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
    Set sh58 = ThisWorkbook.Sheets("58 счет")
    Set sh76 = ThisWorkbook.Sheets("76 счет")
    Set sh = ThisWorkbook.Sheets("Сравнения")
    
    sh.Cells.Clear
    sh.Cells( 1 ,  1 ) = "Вексель"
    sh.Cells( 1 ,  2 ) = "Дебет 58"
    sh.Cells( 1 ,  3 ) = "Кредит 58"
    sh.Cells( 1 ,  4 ) = "Дебет 76"
    sh.Cells( 1 ,  5 ) = "Кредит 76"
    
    Set recSet = CreateObject("ADODB.Recordset")
    recSet.CursorLocation = adUseClient
    recSet.Open "select [Вексель], [Дебит 76], [Кредит 76] from [76 счет$]", "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 8.0"
    recSet( 0 ).Properties("Optimize") = True
    
    sh58.Range(sh58.Cells( 2 ,  4 ), sh58.Cells( 51568 ,  4 )) = "нет"
    l =  1 
    For i =  2  To  51568 
        txt58 = sh58.Cells(i,  1 )
        recSet.Find "[Вексель] = '" & txt58 & "'",  0 ,  1 ,  1 
        If Not recSet.EOF Then
            l = l +  1 
            sh.Cells(l,  1 ) = txt58
            sh.Cells(l,  2 ) = sh58.Cells(i,  2 )
            sh.Cells(l,  3 ) = sh58.Cells(i,  3 )
            sh.Cells(l,  4 ) = recSet( 1 )
            sh.Cells(l,  5 ) = recSet( 2 )
            sh58.Cells(i,  4 ) = ""
        End If
    Next i
У меня на машине - 9 сек.
...
Рейтинг: 0 / 0
20.06.2007, 07:25
    #34606464
TIKO
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
То РА
если уж решаемся на ADO то грех не использовать все возможности скул запросов а именно

Код: plaintext
1.
recSet.Open "select [Вексель], [Дебит 76], [Кредит 76] from [76 счет$] WHERE [Вексель] IN (SELECT [Вексель] FROM [58 счет$])  ",  _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 8.0"
рекордсет уже содержит все схожие записи надо просто его прокуртить и добавить в литс сравнений и циклов для сравнений не надо

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
With recSet
Do Until .EOF
If Not IsNull(recSet.Fields("Вексель").Value) Then 
Debug.Print recSet.Fields("Вексель").Value
End If
.MoveNext
Loop
    
...
Рейтинг: 0 / 0
20.06.2007, 08:14
    #34606531
TIKO
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
еще вариант 1-2 сек без циклов и прокрутки рекодсета

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
Dim comm As Object
Dim con As Object
Set con = CreateObject("ADODB.Connection")
Set comm = CreateObject("ADODB.Command")
con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=Excel 8.0"

With comm
.ActiveConnection = con
.CommandText = "INSERT INTO [Сравнения$] ([Вексель], [Дебет 58],[Кредит 58],[Дебет 76],[Кредит 76]) " _
& " select [Вексель],NULL,NULL, [Дебит 76], [Кредит 76] from [76 счет$] where [Вексель] in (select [Вексель] from [58 счет$]) "
.Execute
End With

но в первом и втором особенно варианте не учтено обновление поля не соответствий словом "Нет"
...
Рейтинг: 0 / 0
20.06.2007, 11:21
    #34607036
AndrF
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оптимизация программного кода
TIKOно в первом и втором особенно варианте не учтено обновление поля не соответствий словом "Нет"

GetFromRecordset - одной командой заполняем третий лист.

Аналогично делается выборка и под колонку со словом "Нет" для второго листа - там запрос только другой будет...
...
Рейтинг: 0 / 0
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / оптимизация программного кода / 24 сообщений из 24, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]