Помогите доработать макрос SQL-запроса в Excel. / Microsoft Office

ReSQL.ru

Мобильная версия Контакт Правила FAQ Помощь

Гость

Войти | Регистрация | Профиль | Очистить

Новые сообщения | Избранное

Форумы | Пользователи | Статистика | Мод. лог | Поиск

Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр

Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите доработать макрос SQL-запроса в Excel.

7 сообщений из 7, страница 1 из 1

Помогите доработать макрос SQL-запроса в Excel.

#38728721

Maxim12345678

Гость

Доброе утро. Написал макрос, который вытягивает данные с листа 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("&#199;&#224;&#239;&#240;&#238;&#241;").Cells(2, 3)
'===
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("C6").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") & "# 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;]='&#208;&#224;&#225;&#238;&#242;&#224;&#229;&#242;'")
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("D6:D" & CStr(Lastrow_WB) & "")
    Cells(RR.Row, 4) = "&#208;&#224;&#225;&#238;&#242;&#224;&#229;&#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;]=''")
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, 09:53

| Ответить | Цитировать | Написать

Помогите доработать макрос SQL-запроса в Excel.

#38728731

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.

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:11

| Ответить | Цитировать | Написать

Помогите доработать макрос SQL-запроса в Excel.

#38728736

Триггерман

Участник

Сообщения: 99

Рейтинг: 0 / 0

Maxim12345678,
Не стоит так жутко хардкодить строковые константы (литералы) прямо в коде процедуры.
Храните строковые шаблоны и константы в ячейках на отдельном листе, в мемо-полях формы, во внешнем текстовом файле на худой конец.

...

Рейтинг:

0 / 0

26.08.2014, 10:21

| Ответить | Цитировать | Написать

Помогите доработать макрос SQL-запроса в Excel.

#38728737

Shocker.Pro

Участник

Откуда: ->|<- :адуктО

Сообщения: 23 134

Рейтинг: 0 / 0

1) необязательно закрывать/открывать соединение каждый раз, можно открыть в начале и закрыть в конце

2) на беглый взгляд не понимаю, зачем нужно запрашивать три раза, почему бы не возвращать нужный столбец сразу в запросе:

Код: vbnet

Conn.Execute("SELECT [Nomer_dogovora], формула_для_второго_столбца FROM [1$] WHERE.....")

3) есть гораздо более простой способ формирование Range, зная номера строк/столбцов:

Код: vbnet

Range(Cells(10,4),Cells(20,4))

...

Рейтинг:

0 / 0

26.08.2014, 10:24

| Ответить | Цитировать | Написать

Помогите доработать макрос SQL-запроса в Excel.

#38728766

Maxim12345678

Гость

Триггерман,
мне казалось, что так проще вставлять диапазоны один за другим, чтобы не запутаться... учту на будущее, спасибо.

...

Рейтинг:

0 / 0

26.08.2014, 10:45

| Ответить | Цитировать | Написать

Помогите доработать макрос SQL-запроса в Excel.

#38728773

Maxim12345678

Гость

Shocker.Pro, спасибо за советы

1) если не закрывать\открывать соединение, то Excel ругается, что открытая книга уже используется и не хочет выполнять 2 запрос. Хотя над этим еще подумаю
2) я просто тупо не знал, что можно в запросе задавать значения другого столбца. Пытаюсь оптимизировать рутину в Excel и попутно изучаю sql, буду пробовать.
3) об этом способе знаю, но мне было проще использовать так.

...

Рейтинг:

0 / 0

26.08.2014, 10:50

| Ответить | Цитировать | Написать

Помогите доработать макрос SQL-запроса в Excel.

#38728856

Maxim12345678

Гость

Триггерман, Shocker.Pro спасибо за подсказки, код переделал, получилось проще и без всяких извращений.

...

Рейтинг:

0 / 0

26.08.2014, 11:51

| Ответить | Цитировать | Написать

7 сообщений из 7, страница 1 из 1

Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Помогите доработать макрос SQL-запроса в Excel.

Цитировать

Написать

Автор*:

Ввести пароль для входа

Тема*:

Сообщение

Данное сообщение тематическое

Сообщение содержит картинки или видео 18+

Автор:

ВНИМАНИЕ! На данном подфоруме действуют строгие правила. Удостоверьтесь, что ваше сообщение соответствует им!

Форум или тема закрыты для гостей. Необходима авторизация!

Загрузить последнюю сохраненную версию

Вложение:

Вставить как галерею

Максимальный размер вложений: 4,0 МБ, аудио/видео: 8,0 МБ. Картинки большего размера ужимаются, если возможно.

Введите код, изображенный на картинке. Если код нечитаемый, кликните картинку, чтобы загрузить другой вариант.

Отправляя сообщение, я выражаю свое согласие с правилами форума и принимаю пользовательское соглашение.

Читали тему (0):

Читали форум (0):

Пользователи онлайн (0):

start [/forum/topic.php?fid=61&fpage=55&tid=2173878]:	0ms
get settings:	11ms
get forum list:	14ms
check forum access:	2ms
check topic access:	2ms
track hit:	29ms
get topic data:	13ms
get forum data:	3ms
get page messages:	49ms
get tp. blocked users:	1ms
others:	278ms

total:	402ms