Гость
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / оцените плиз мой первый макрос. Что можно подкрутить / 7 сообщений из 7, страница 1 из 1
25.04.2012, 09:35
    #37769795
LudeV
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оцените плиз мой первый макрос. Что можно подкрутить
Добрый день,

написал свой первый макрос, хотелось бы узнать мнение профи, чтобы сразу избежать ошибок и на будущее запомнить это.

Задача:
есть заполненный столбец в листе, необходимо для каждой записи из этого столбца подтянуть некоторые другие данные из БД.

Делаю:
коннект к БД и в цикле работаю с этим листом, вызывая хранимую процедуру и каждый раз передавая ей в качестве параметра значение из этого столбца. Все,что возвращает БД, помещаю в recordset и оттуда вставляю в лист.
Во время выборки максимальной даты придумал временное решение: засунуть в ячейку, потом в переменную и очистить ячейку.
Вот листинг макроса:

Код: vbnet
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.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
'StatusBar at the end of file
    Application.StatusBar = "Importing data from SQL server..."
    
'clearing worksheet
    Worksheets("Import").Range("C2:Z50000").Clear
    
'connecting to DB to call procedure
    Set rst = New ADODB.Recordset
    Set Cnn = New ADODB.Connection
    Cnn.ConnectionString = "Provider=SQLOLEDB;Server=**;Trusted_Connection=Yes"
    Cnn.ConnectionTimeout = 0
    Cnn.CommandTimeout = 0
    Cnn.Open
    
'connecting to DB to select max(date) only once
    Set rst2 = New ADODB.Recordset
    rst2.ActiveConnection = Cnn
    Set rst2 = Cnn.Execute("select  *")
    
    Call ActiveSheet.Cells(100, 100).CopyFromRecordset(rst2)
    rep_date = ActiveSheet.Cells(100, 100).Value
    ActiveSheet.Cells(100, 100).Clear
    
    Set rst2 = Nothing
        
'working with sheet "Import"
        With Sheets("Import")
        
'breaking loop
                    If ((.Cells(2, 1) = "") And (.Cells(3, 1) = "")) Then
                        Application.StatusBar = False
                        MsgBox ("No data is available.")
                        Application.ScreenUpdating = True
                        Cnn.Close
                        Exit Sub
                    End If
                    
 '----end breaking loop
                    
            i = 2
Pustoe_pole:
            Do While Not ((.Cells(i, 2) = "") And (.Cells(i, 1) = "") And (.Cells(i + 1, 2) = "") And (.Cells(i + 1, 1) = ""))
            
'reading cust_numbers
                customer = .Cells(i, 1).Value
                If customer = "" Then
                    i = i + 1
                    GoTo Pustoe_pole
                End If
                
'calling to procedure
                SQL_Query = "exec ** '" & customer & "','" & rep_date & "'"
                rst.Open SQL_Query, Cnn
                
'inserting data into sheet
                .Cells(i, 3).CopyFromRecordset rst
 
                rst.Close
                i = i + 1
            Loop
      
        .Cells.Columns.AutoFit
        End With
        
 'Ending
    Set rst = Nothing
    Cnn.Close
    Set Cnn = Nothing
    Application.StatusBar = False
    MsgBox "Done!"
    
End Sub


спасибо всем большое. Модератор: учимся пользоваться тэгами оформления кода
...
Рейтинг: 0 / 0
25.04.2012, 09:36
    #37769800
LudeV
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оцените плиз мой первый макрос. Что можно подкрутить
LudeV,

прошу подсказки, потому что есть 2 проблемы:

1) долгая работа всего макроса,но это некритично и в принципе может быть связана с работой БД
2) на время работы лист подвисает и работать нормально не получается - это критично,но как исправить пока не нашел
...
Рейтинг: 0 / 0
25.04.2012, 10:09
    #37769860
BelowZero
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оцените плиз мой первый макрос. Что можно подкрутить
LudeV,

попробуй поставить DoEvents в цикл.
...
Рейтинг: 0 / 0
25.04.2012, 11:03
    #37770013
LudeV
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оцените плиз мой первый макрос. Что можно подкрутить
BelowZero,


да, действительно, помогло.

спасибо большое
...
Рейтинг: 0 / 0
25.04.2012, 11:03
    #37770015
Игорь Горбонос
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оцените плиз мой первый макрос. Что можно подкрутить
> Автор: LudeV
> 1) долгая работа всего макроса,но это некритично и в принципе может быть связана с работой БД

Это может быть связано с неоптимальным алгоритмом. Опиши словами что нужно сделать.

> 2) на время работы лист подвисает и работать нормально не получается - это критично,но как исправить пока не
> нашел

Когда работает макрос, работать с Екселем все равно не получится. Поэтому интересует что за критичность такая может
быть?

Posted via ActualForum NNTP Server 1.5
...
Рейтинг: 0 / 0
25.04.2012, 13:13
    #37770401
скукотища
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оцените плиз мой первый макрос. Что можно подкрутить
LudeV,
_возможно_, ускорить выполнение получится, если для получения значений в цикле вместо ADODB.Recordset использовать подготовленную команду с параметрами ( ADODB.Command ).

ЗЫ:
Код: vbnet
1.
2.
3.
4.
5.
6.
' промежуточное сохранение на лист - лишнее:
'    Call ActiveSheet.Cells(100, 100).CopyFromRecordset(rst2)
'    rep_date = ActiveSheet.Cells(100, 100).Value
'    ActiveSheet.Cells(100, 100).Clear

    rep_date = rst2(0).Value


...
Рейтинг: 0 / 0
25.04.2012, 14:07
    #37770522
LudeV
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
оцените плиз мой первый макрос. Что можно подкрутить
скукотища,

спасибо всем

остановился на своем варианте, т.к. работает столько же,если бы я выбирал из базы ручками.

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


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