ReSQL.ru
     
powered by simpleCommunicator - 2.0.39     © 2025 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Перебор ячеек в диапазоне с использованием запроса.
4 сообщений из 4, страница 1 из 1
Перебор ячеек в диапазоне с использованием запроса.
    #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:31
| Ответить | Цитировать | Написать  
Перебор ячеек в диапазоне с использованием запроса.
    #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, 10:35
| Ответить | Цитировать | Написать  
Перебор ячеек в диапазоне с использованием запроса.
    #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
15.01.2015, 15:16
| Ответить | Цитировать | Написать  
Перебор ячеек в диапазоне с использованием запроса.
    #38855777
Maxim12345678
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Maxim12345678
Гость
HandKot, доброе утро. Спасибо за совет, попробую так сделать.
...
Рейтинг: 0 / 0
16.01.2015, 09:06
| Ответить | Цитировать | Написать  
4 сообщений из 4, страница 1 из 1
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Перебор ячеек в диапазоне с использованием запроса.
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
NoSQL.ru             Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=61&fpage=51&tid=2173686]:
 0ms
get settings:
 9ms
get forum list:
 11ms
check forum access:
 4ms
check topic access:
 4ms
track hit:
 25ms
get topic data:
 10ms
get forum data:
 2ms
get page messages:
 39ms
get tp. blocked users:
 2ms
others: 12ms
total:  118ms
созд. / загр.: 118ms
x
x
Закрыть


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