Гость
Войти | Профиль | Очистить
Действия ...
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Перебор ячеек в диапазоне с использованием запроса. / 4 сообщений из 4, страница 1 из 1
15.01.2015, 10:31
    #38854899
Maxim12345678
Maxim12345678
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перебор ячеек в диапазоне с использованием запроса.
Доброе утро. Есть база в Access (807к строк, 13 столбцов) и диапазон ячеек в Excel(40 на 40). Для каждой ячейки диапазона отправляется запрос в Access и выгружаются данные. Время запроса от 25 минут и более. Можно ли как-то сократить время выполнения или же хранить данные в другом месте. Из все доступных инструментов могу пользоваться MS Office. Спасибо заранее!
Вот код:
 
Код: 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.
Sub VintageAnalis()

    '===
    
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayStatusBar = False
Application.DisplayAlerts = False

    '===

Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim a As Workbook
Dim k As Long, k1 As Long, i As Range, mv As String, pp As String
    Set a = ThisWorkbook
    k = a.Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row 'Íîìåð ïîñëåäíåé çàïîëíåííîé ñòðîêè
    k1 = a.Sheets(2).UsedRange.Columns.Count 'Íîìåð ïîñëåäíåãî ñòîëáöà, åñëè íåò ïóñòûõ ÿ÷ååê â ñòðîêå 2
    a.Sheets(2).Range(a.Sheets(2).Cells(3, 2), a.Sheets(2).Cells(k, k1)).ClearContents
    '===
    
    Set conn = New ADODB.Connection 'Ñîçäàåì íîâîå ïîäêëþ÷åíèå
    conn = "Driver={Microsoft Access Driver (*.mdb, *.accdb)};Dbq=O:\Âèíòàæè.accdb;Uid=Admin;Pwd=;"
    conn.Open
    
    '===
    
    'If conn.State = 1 Then
    'MsgBox "Åñòü êîíòàêò!"
    'Else
    'MsgBox "Áåäà :("
    'End If
    
    '===
    
   For Each i In a.Sheets(2).Range(a.Sheets(2).Cells(3, 2), a.Sheets(2).Cells(k, k1))
       mv = a.Sheets(2).Cells(i.Row, 1)
       pp = a.Sheets(2).Cells(2, i.Column)
       'MsgBox pp
       Set rst = New ADODB.Recordset 'Ñîçäàåì îáúåêò Recordset äëÿ çàïèñè SQL-êîäà
       rst.Open ("SELECT SUM(Ïîðòôåëü.Ðàçìåð_êðåäèòà) From Ïîðòôåëü WHERE Ïîðòôåëü.Ìåñÿö_âûäà÷è = '" & CStr(mv) & "' AND Ïîðòôåëü.Ìåñÿöû_ïîñëå_âûäà÷è = '" & CStr(pp) & "' AND Ïîðòôåëü.Äåôîëò = 'Äà'"), conn 'Çàïèñûâàåì êîä â Recordset
       a.Sheets(2).Cells(i.Row, i.Column).CopyFromRecordset rst 'Êîïèðóåì èç Recordset
   Next i
    
    '===
    
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.DisplayAlerts = True

    '===
    
End Sub

...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
15.01.2015, 10:35
    #38854907
Maxim12345678
Maxim12345678
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перебор ячеек в диапазоне с использованием запроса.
Maxim12345678,

 
Код: 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.
Sub VintageAnalis()

    '===
    
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.DisplayStatusBar = False
Application.DisplayAlerts = False

    '===

Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim a As Workbook
Dim k As Long, k1 As Long, i As Range, mv As String, pp As String
    Set a = ThisWorkbook
    k = a.Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row 
    k1 = a.Sheets(2).UsedRange.Columns.Count 
    a.Sheets(2).Range(a.Sheets(2).Cells(3, 2), a.Sheets(2).Cells(k, k1)).ClearContents
    '===
    
    Set conn = New ADODB.Connection 
    conn = "Driver={Microsoft Access Driver (*.mdb, *.accdb)};Dbq=O:\Vintage.accdb;Uid=Admin;Pwd=;"
    conn.Open
    
    '===
    
    'If conn.State = 1 Then
    'MsgBox "Est kontakt!"
    'Else
    'MsgBox "Beda :("
    'End If
    
    '===
    
   For Each i In a.Sheets(2).Range(a.Sheets(2).Cells(3, 2), a.Sheets(2).Cells(k, k1))
       mv = a.Sheets(2).Cells(i.Row, 1)
       pp = a.Sheets(2).Cells(2, i.Column)
       'MsgBox pp
       Set rst = New ADODB.Recordset 
       rst.Open ("SELECT SUM(Portfel.Razmer_kredita) From Portfel WHERE Portfel.Mecyac_vidachi= '" & CStr(mv) & "' AND Portfel.Mecyaci_posle_vidachi = '" & CStr(pp) & "' AND Portfel.defolt = Da"), conn 
       a.Sheets(2).Cells(i.Row, i.Column).CopyFromRecordset rst 
   Next i
    
    '===
    
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.DisplayStatusBar = True
Application.DisplayAlerts = True

    '===
    
End Sub

...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
15.01.2015, 15:16
    #38855308
HandKot
HandKot
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перебор ячеек в диапазоне с использованием запроса.
действительно как вариант выгрузить на отдельный лист
и потом оттуда забирать данные


Код: vbnet
1.
2.
3.
4.
5.
6.
7.
8.
       Set rst = New ADODB.Recordset 
       rst.Open ("SELECT Portfel.Mecyac_vidachi, Portfel.Mecyaci_posle_vidachi , SUM(Portfel.Razmer_kredita) From Portfel WHERE Portfel.defolt = Da GROUP BY Portfel.Mecyac_vidachi, Portfel.Mecyaci_posle_vidachi"), conn 

       a.Sheets("тут лист для данных").Cells(i.Row, i.Column).CopyFromRecordset rst 

   For Each i In a.Sheets(2).Range(a.Sheets(2).Cells(3, 2), a.Sheets(2).Cells(k, k1))
       тута код для поиска данных на листе и вставки в нужную ячейку
   Next i
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
16.01.2015, 09:06
    #38855777
Maxim12345678
Maxim12345678
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Перебор ячеек в диапазоне с использованием запроса.
HandKot, доброе утро. Спасибо за совет, попробую так сделать.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Перебор ячеек в диапазоне с использованием запроса. / 4 сообщений из 4, страница 1 из 1
Целевая тема:
Создать новую тему:
Автор:
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
созд. / загр.: 408ms
Закрыть
start [/forum/topic.php?fid=61&tablet=1&tid=2173686]:
 0ms
get settings:
 9ms
get forum list:
 14ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 33ms
get topic data:
 9ms
get forum data:
 2ms
get page messages:
 40ms
get tp. blocked users:
 2ms
others: 291ms
total:  408ms
x
x
Закрыть


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