Гость
Войти | Профиль | Очистить
Действия ...
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите доработать макрос SQL-запроса в Excel. / 7 сообщений из 7, страница 1 из 1
26.08.2014, 09:53
    #38728721
Maxim12345678
Maxim12345678
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите доработать макрос SQL-запроса в Excel.
Доброе утро. Написал макрос, который вытягивает данные с листа 1 в столбец C другого листа через SQL-запрос и проставляет в соседнем столбце D статус договора. Проблема в том, что имеется 3 разных статуса договора, для некоторых статусов имеется 2-3 условия выборки. Не придумал ничего лучше, как открывать соединение, копировать данные, проставлять статус, закрывать соединение и проделывать еще 2 раза. Может быть можно как-то проще все сделать и проставлять статус сразу после отработки кода SQL? Спасибо за помощь.

Код: 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.
Dim Conn As New ADODB.Connection, This_WB As Workbook, Data As String, Lastrow_WB As Long, RR As Range, Lastrow_WB1 As Long
Set This_WB = ThisWorkbook
Data = This_WB.Sheets("Çàïðîñ").Cells(2, 3)
'===
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Extended Properties=""Excel 8.0; HDR=Yes;""; Data Source=" & This_WB.FullName
Sheets("Çàïðîñ").Range("C6").CopyFromRecordset _
Conn.Execute("SELECT [Íîìåð äîãîâîðà] FROM [1$] WHERE [Ñîñòîÿíèå]='Çàêðûò' AND [Äàòà çàêðûòèÿ] >= #" & Format(Data, "mm-dd-yyyy") & "# UNION ALL SELECT [Íîìåð äîãîâîðà] FROM [1$] WHERE [Ñîñòîÿíèå]='Ðàáîòàåò'")
Conn.Close
'===
Lastrow_WB = This_WB.Sheets("Çàïðîñ").Cells(Rows.Count, "C").End(xlUp).Row
 For Each RR In This_WB.Sheets("Çàïðîñ").Range("D6:D" & CStr(Lastrow_WB) & "")
    Cells(RR.Row, 4) = "Ðàáîòàåò"
 Next RR
'===
Lastrow_WB1 = This_WB.Sheets("Çàïðîñ").Cells(Rows.Count, "D").End(xlUp).Row
'===
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Extended Properties=""Excel 8.0; HDR=Yes;""; Data Source=" & This_WB.FullName
Sheets("Çàïðîñ").Range("C" & CStr(Lastrow_WB1 + 1) & "").CopyFromRecordset _
Conn.Execute("SELECT [&#205;&#238;&#236;&#229;&#240; &#228;&#238;&#227;&#238;&#226;&#238;&#240;&#224;] FROM [1$] WHERE [&#209;&#238;&#241;&#242;&#238;&#255;&#237;&#232;&#229;]='&#199;&#224;&#234;&#240;&#251;&#242;' AND [&#196;&#224;&#242;&#224; &#231;&#224;&#234;&#240;&#251;&#242;&#232;&#255;] < #" & Format(Data, "mm-dd-yyyy") & "# AND [&#196;&#238;&#227;&#238;&#226;&#238;&#240; &#239;&#240;&#238;&#228;&#224;&#230;&#232;]=''")
Conn.Close
'===
Lastrow_WB = This_WB.Sheets("&#199;&#224;&#239;&#240;&#238;&#241;").Cells(Rows.Count, "C").End(xlUp).Row
 For Each RR In This_WB.Sheets("&#199;&#224;&#239;&#240;&#238;&#241;").Range("D" & CStr(Lastrow_WB1 + 1) & ":D" & CStr(Lastrow_WB) & "")
    Cells(RR.Row, 4) = "&#199;&#224;&#234;&#240;&#251;&#242;"
 Next RR
'===
Lastrow_WB1 = This_WB.Sheets("&#199;&#224;&#239;&#240;&#238;&#241;").Cells(Rows.Count, "D").End(xlUp).Row
'===
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Extended Properties=""Excel 8.0; HDR=Yes;""; Data Source=" & This_WB.FullName
Sheets("&#199;&#224;&#239;&#240;&#238;&#241;").Range("C" & CStr(Lastrow_WB1 + 1) & "").CopyFromRecordset _
Conn.Execute("SELECT [&#205;&#238;&#236;&#229;&#240; &#228;&#238;&#227;&#238;&#226;&#238;&#240;&#224;] FROM [1$] WHERE [&#209;&#238;&#241;&#242;&#238;&#255;&#237;&#232;&#229;]='&#199;&#224;&#234;&#240;&#251;&#242;' AND [&#196;&#224;&#242;&#224; &#231;&#224;&#234;&#240;&#251;&#242;&#232;&#255;] < #" & Format(Data, "mm-dd-yyyy") & "# AND [&#196;&#238;&#227;&#238;&#226;&#238;&#240; &#239;&#240;&#238;&#228;&#224;&#230;&#232;]<>'' UNION ALL SELECT [&#205;&#238;&#236;&#229;&#240; &#228;&#238;&#227;&#238;&#226;&#238;&#240;&#224;] FROM [1$] WHERE [&#209;&#238;&#241;&#242;&#238;&#255;&#237;&#232;&#229;]='&#207;&#240;&#238;&#228;&#224;&#237;'")
Conn.Close
'===
Lastrow_WB = This_WB.Sheets("&#199;&#224;&#239;&#240;&#238;&#241;").Cells(Rows.Count, "C").End(xlUp).Row
 For Each RR In This_WB.Sheets("&#199;&#224;&#239;&#240;&#238;&#241;").Range("D" & CStr(Lastrow_WB1 + 1) & ":D" & CStr(Lastrow_WB) & "")
    Cells(RR.Row, 4) = "&#207;&#240;&#238;&#228;&#224;&#237;"
 Next RR
End Sub
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
26.08.2014, 10:11
    #38728731
Maxim12345678
Maxim12345678
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите доработать макрос SQL-запроса в Excel.
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.
Dim Conn As New ADODB.Connection, This_WB As Workbook, Data As String, Lastrow_WB As Long, RR As Range, Lastrow_WB1 As Long
Set This_WB = ThisWorkbook
Data = This_WB.Sheets("Zapros").Cells(2, 3)
'===
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Extended Properties=""Excel 8.0; HDR=Yes;""; Data Source=" & This_WB.FullName
Sheets("Zapros").Range("C6").CopyFromRecordset _
Conn.Execute("SELECT [Nomer_dogovora] FROM [1$] WHERE [Sostoyanie]='Zakrit' AND [Date_zakritiya] >= #" & Format(Data, "mm-dd-yyyy") & "# UNION ALL SELECT [Nomer_dogovora] FROM [1$] WHERE [Sostoyanie]='Rabotaet'")
Conn.Close
'===
Lastrow_WB = This_WB.Sheets("Zapros").Cells(Rows.Count, "C").End(xlUp).Row
 For Each RR In This_WB.Sheets("Zapros").Range("D6:D" & CStr(Lastrow_WB) & "")
    Cells(RR.Row, 4) = "Rabotaet"
 Next RR
'===
Lastrow_WB1 = This_WB.Sheets("Zapros").Cells(Rows.Count, "D").End(xlUp).Row
'===
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Extended Properties=""Excel 8.0; HDR=Yes;""; Data Source=" & This_WB.FullName
Sheets("Zapros").Range("C" & CStr(Lastrow_WB1 + 1) & "").CopyFromRecordset _
Conn.Execute("SELECT [Nomer_dogovora] FROM [1$] WHERE [Sostoyanie]='Zakrit' AND [Date_zakritiya] < #" & Format(Data, "mm-dd-yyyy") & "# AND [Dogovor_prodaji]=''")
Conn.Close
'===
Lastrow_WB = This_WB.Sheets("Zapros").Cells(Rows.Count, "C").End(xlUp).Row
 For Each RR In This_WB.Sheets("Zapros").Range("D" & CStr(Lastrow_WB1 + 1) & ":D" & CStr(Lastrow_WB) & "")
    Cells(RR.Row, 4) = "Zakrit"
 Next RR
'===
Lastrow_WB1 = This_WB.Sheets("Zapros").Cells(Rows.Count, "D").End(xlUp).Row
'===
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Extended Properties=""Excel 8.0; HDR=Yes;""; Data Source=" & This_WB.FullName
Sheets("Zapros").Range("C" & CStr(Lastrow_WB1 + 1) & "").CopyFromRecordset _
Conn.Execute("SELECT [Nomer_dogovora] FROM [1$] WHERE [Sostoyanie]='Zakrit' AND [Data_zakritiya] < #" & Format(Data, "mm-dd-yyyy") & "# AND [Dogovor_prodaji]<>'' UNION ALL SELECT [Nomer_dogovora] FROM [1$] WHERE [Sostoyanie]='Prodan'")
Conn.Close
'===
Lastrow_WB = This_WB.Sheets("Zapros").Cells(Rows.Count, "C").End(xlUp).Row
 For Each RR In This_WB.Sheets("Zapros").Range("D" & CStr(Lastrow_WB1 + 1) & ":D" & CStr(Lastrow_WB) & "")
    Cells(RR.Row, 4) = "Prodan"
 Next RR
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
26.08.2014, 10:21
    #38728736
Триггерман
Триггерман
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите доработать макрос SQL-запроса в Excel.
Maxim12345678,
Не стоит так жутко хардкодить строковые константы (литералы) прямо в коде процедуры.
Храните строковые шаблоны и константы в ячейках на отдельном листе, в мемо-полях формы, во внешнем текстовом файле на худой конец.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
26.08.2014, 10:24
    #38728737
Shocker.Pro
Shocker.Pro
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите доработать макрос SQL-запроса в Excel.
1) необязательно закрывать/открывать соединение каждый раз, можно открыть в начале и закрыть в конце

2) на беглый взгляд не понимаю, зачем нужно запрашивать три раза, почему бы не возвращать нужный столбец сразу в запросе:
Код: vbnet
1.
Conn.Execute("SELECT [Nomer_dogovora], формула_для_второго_столбца FROM [1$] WHERE.....")



3) есть гораздо более простой способ формирование Range, зная номера строк/столбцов:
Код: vbnet
1.
Range(Cells(10,4),Cells(20,4))
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
26.08.2014, 10:45
    #38728766
Maxim12345678
Maxim12345678
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите доработать макрос SQL-запроса в Excel.
Триггерман,
мне казалось, что так проще вставлять диапазоны один за другим, чтобы не запутаться... учту на будущее, спасибо.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
26.08.2014, 10:50
    #38728773
Maxim12345678
Maxim12345678
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите доработать макрос SQL-запроса в Excel.
Shocker.Pro, спасибо за советы

1) если не закрывать\открывать соединение, то Excel ругается, что открытая книга уже используется и не хочет выполнять 2 запрос. Хотя над этим еще подумаю
2) я просто тупо не знал, что можно в запросе задавать значения другого столбца. Пытаюсь оптимизировать рутину в Excel и попутно изучаю sql, буду пробовать.
3) об этом способе знаю, но мне было проще использовать так.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
26.08.2014, 11:51
    #38728856
Maxim12345678
Maxim12345678
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Помогите доработать макрос SQL-запроса в Excel.
Триггерман, Shocker.Pro спасибо за подсказки, код переделал, получилось проще и без всяких извращений.
...
Рейтинг: 0 / 0
| Ответить | Цитировать | Написать  
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите доработать макрос SQL-запроса в Excel. / 7 сообщений из 7, страница 1 из 1
Целевая тема:
Создать новую тему:
Автор:
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение
созд. / загр.: 124ms
Закрыть
start [/forum/topic.php?fid=61&tablet=1&tid=2173878]:
 0ms
get settings:
 9ms
get forum list:
 13ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 25ms
get topic data:
 11ms
get forum data:
 3ms
get page messages:
 42ms
get tp. blocked users:
 2ms
others: 13ms
total:  124ms
x
x
Закрыть


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