Access2010 запрос на выборку - Мир MS Excel

Регистрация

Напомнить пароль

= Мир MS Excel/Access2010 запрос на выборку - Мир MS Excel

Старая форма входа

Страница 1 из 1 1
Модератор форума: _Boroda_, китин

Access2010 запрос на выборку (пример во вложении не знаю как кратко сформулировать задачу)

Access2010 запрос на выборку

Дата: Суббота, 21.01.2017, 00:12 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 16

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Добрый день!
Помогите пожалуйста с запросом, не знаю с какой стороны к нему подойти...
таблица 1 (с данными) содержит поля СЧ, Х1,Х2,Х3
таблица 2 (с условием выборки) содержит поля ХХ1, ХХ2, ХХ3, КОД
поле Х1 аналогично полю ХХ1, поле Х2 аналогично полю ХХ2, поле Х3 аналогично полю ХХ3
Запрос 1 должен вывести поля:Х1,Х2,Х3, ИТОГ
Итог вычисляется путем поиска совпадений аналогичных полей (сравниваются все 3 поля), если в ячейке с условием пусто, то это означает, что подходит любое значение
например в ИТОГ должно папасть следующее :
№ записи ИТОГ пояснение
1 Н сработала 3 строчка условия Таблицы 2
2 Ф сработала 40 строчка условия Таблицы 2
3 Ф сработала 24 строчка условия Таблицы 2
4 У сработала 22 строчка условия Таблицы 2
5 не сработало ни одно из условий
6 Ф,Н,С сработали 29, 4, 19 строчки условия Таблицы 2
7 Р сработала 18 строчка условия Таблицы 2

и т.д.
Пример БД во вложении. Можно все менять кроме Таблицы 1 - она должна оставаться не тронутой.

К сообщению приложен файл: Database1.zip (36.4 Kb)

с Уважением, Владимир

Ответить

Дата: Суббота, 21.01.2017, 03:23 | Сообщение № 2

Группа: Друзья

Ранг: Старожил

Сообщений: 2347

Репутация: 997 ±

Замечаний: 0% ±

Excel 2007,2010,2013

Здравствуйте
В стандартный модуль код (взят отсюда)
[vba]

Код

Option Compare Database

Function Concatenate(pstrSQL As String, _
        Optional pstrDelim As String = ", ") _
        As String
    'Created by Duane Hookom, 2003
    'this code may be included in any application/mdb providing
    '   this statement is left intact
    'example
    'tblFamily with FamID as numeric primary key
    'tblFamMem with FamID, FirstName, DOB,...
    'return a comma separated list of FirstNames
    'for a FamID
    ' John, Mary, Susan
    'in a Query
    'SELECT FamID,
    'Concatenate("SELECT FirstName FROM tblFamMem
    ' WHERE FamID =" & [FamID]) as FirstNames
    'FROM tblFamily
    '

    '======For DAO uncomment next 4 lines=======
    '====== comment out ADO below =======
    'Dim db As DAO.Database
    'Dim rs As DAO.Recordset
    'Set db = CurrentDb
    'Set rs = db.OpenRecordset(pstrSQL)

    '======For ADO uncomment next two lines=====
    '====== comment out DAO above ======
    Dim rs As New ADODB.Recordset
    rs.Open pstrSQL, CurrentProject.Connection, _
    adOpenKeyset, adLockOptimistic
    Dim strConcat As String 'build return string
    With rs
        If Not .EOF Then
            .MoveFirst
            Do While Not .EOF
                strConcat = strConcat & _
                .Fields(0) & pstrDelim
                .MoveNext
            Loop
        End If
        .Close
    End With
    Set rs = Nothing
    '====== uncomment next line for DAO ========
    'Set db = Nothing
    If Len(strConcat) > 0 Then
        strConcat = Left(strConcat, _
        Len(strConcat) - Len(pstrDelim))
    End If
    Concatenate = strConcat
End Function

[/vba]
и SQL код запроса [vba]

Код

SELECT *
FROM
    (SELECT
        СЧ,
        x1,
        x2,
        x3,
        Concatenate(
            "SELECT
                [КОД]
            FROM
                [Таблица2]
            WHERE
                '"&x1&"' LIKE IIF(xx1 IS NULL OR cStr(xx1)='','%',cStr(xx1)) AND
                '"&x2&"' LIKE IIF(xx2 IS NULL OR cStr(xx2)='','%',cStr(xx2)) AND
                '"&x3&"' LIKE IIF(xx3 IS NULL OR cStr(xx3)='','%',cStr(xx3))
            ORDER BY КОД"
        ) AS ИТОГ
    FROM
        Таблица1
    GROUP BY
        СЧ,
        x1,
        x2,
        x3
    ORDER BY СЧ)  AS t1
WHERE ИТОГ<>'';

[/vba]

Здравствуйте
В стандартный модуль код (взят отсюда)
[vba]

Код

Option Compare Database

Function Concatenate(pstrSQL As String, _
        Optional pstrDelim As String = ", ") _
        As String
    'Created by Duane Hookom, 2003
    'this code may be included in any application/mdb providing
    '   this statement is left intact
    'example
    'tblFamily with FamID as numeric primary key
    'tblFamMem with FamID, FirstName, DOB,...
    'return a comma separated list of FirstNames
    'for a FamID
    ' John, Mary, Susan
    'in a Query
    'SELECT FamID,
    'Concatenate("SELECT FirstName FROM tblFamMem
    ' WHERE FamID =" & [FamID]) as FirstNames
    'FROM tblFamily
    '

    '======For DAO uncomment next 4 lines=======
    '====== comment out ADO below =======
    'Dim db As DAO.Database
    'Dim rs As DAO.Recordset
    'Set db = CurrentDb
    'Set rs = db.OpenRecordset(pstrSQL)

    '======For ADO uncomment next two lines=====
    '====== comment out DAO above ======
    Dim rs As New ADODB.Recordset
    rs.Open pstrSQL, CurrentProject.Connection, _
    adOpenKeyset, adLockOptimistic
    Dim strConcat As String 'build return string
    With rs
        If Not .EOF Then
            .MoveFirst
            Do While Not .EOF
                strConcat = strConcat & _
                .Fields(0) & pstrDelim
                .MoveNext
            Loop
        End If
        .Close
    End With
    Set rs = Nothing
    '====== uncomment next line for DAO ========
    'Set db = Nothing
    If Len(strConcat) > 0 Then
        strConcat = Left(strConcat, _
        Len(strConcat) - Len(pstrDelim))
    End If
    Concatenate = strConcat
End Function

[/vba]
и SQL код запроса [vba]

Код

SELECT *
FROM
    (SELECT
        СЧ,
        x1,
        x2,
        x3,
        Concatenate(
            "SELECT
                [КОД]
            FROM
                [Таблица2]
            WHERE
                '"&x1&"' LIKE IIF(xx1 IS NULL OR cStr(xx1)='','%',cStr(xx1)) AND
                '"&x2&"' LIKE IIF(xx2 IS NULL OR cStr(xx2)='','%',cStr(xx2)) AND
                '"&x3&"' LIKE IIF(xx3 IS NULL OR cStr(xx3)='','%',cStr(xx3))
            ORDER BY КОД"
        ) AS ИТОГ
    FROM
        Таблица1
    GROUP BY
        СЧ,
        x1,
        x2,
        x3
    ORDER BY СЧ)  AS t1
WHERE ИТОГ<>'';

[/vba]krosav4ig

К сообщению приложен файл: 3313549.zip (43.1 Kb)

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Сообщение отредактировал krosav4ig - Суббота, 21.01.2017, 03:25

Ответить

СообщениеЗдравствуйте
В стандартный модуль код (взят отсюда)
[vba]

Код

Option Compare Database

Function Concatenate(pstrSQL As String, _
        Optional pstrDelim As String = ", ") _
        As String
    'Created by Duane Hookom, 2003
    'this code may be included in any application/mdb providing
    '   this statement is left intact
    'example
    'tblFamily with FamID as numeric primary key
    'tblFamMem with FamID, FirstName, DOB,...
    'return a comma separated list of FirstNames
    'for a FamID
    ' John, Mary, Susan
    'in a Query
    'SELECT FamID,
    'Concatenate("SELECT FirstName FROM tblFamMem
    ' WHERE FamID =" & [FamID]) as FirstNames
    'FROM tblFamily
    '

    '======For DAO uncomment next 4 lines=======
    '====== comment out ADO below =======
    'Dim db As DAO.Database
    'Dim rs As DAO.Recordset
    'Set db = CurrentDb
    'Set rs = db.OpenRecordset(pstrSQL)

    '======For ADO uncomment next two lines=====
    '====== comment out DAO above ======
    Dim rs As New ADODB.Recordset
    rs.Open pstrSQL, CurrentProject.Connection, _
    adOpenKeyset, adLockOptimistic
    Dim strConcat As String 'build return string
    With rs
        If Not .EOF Then
            .MoveFirst
            Do While Not .EOF
                strConcat = strConcat & _
                .Fields(0) & pstrDelim
                .MoveNext
            Loop
        End If
        .Close
    End With
    Set rs = Nothing
    '====== uncomment next line for DAO ========
    'Set db = Nothing
    If Len(strConcat) > 0 Then
        strConcat = Left(strConcat, _
        Len(strConcat) - Len(pstrDelim))
    End If
    Concatenate = strConcat
End Function

[/vba]
и SQL код запроса [vba]

Код

SELECT *
FROM
    (SELECT
        СЧ,
        x1,
        x2,
        x3,
        Concatenate(
            "SELECT
                [КОД]
            FROM
                [Таблица2]
            WHERE
                '"&x1&"' LIKE IIF(xx1 IS NULL OR cStr(xx1)='','%',cStr(xx1)) AND
                '"&x2&"' LIKE IIF(xx2 IS NULL OR cStr(xx2)='','%',cStr(xx2)) AND
                '"&x3&"' LIKE IIF(xx3 IS NULL OR cStr(xx3)='','%',cStr(xx3))
            ORDER BY КОД"
        ) AS ИТОГ
    FROM
        Таблица1
    GROUP BY
        СЧ,
        x1,
        x2,
        x3
    ORDER BY СЧ)  AS t1
WHERE ИТОГ<>'';

[/vba]

Автор - krosav4ig
Дата добавления - 21.01.2017 в 03:23

Дата: Суббота, 21.01.2017, 10:57 | Сообщение № 3

Группа: Друзья

Ранг: Ветеран

Сообщений: 581

Репутация: 271 ±

Замечаний: 0% ±

2016, 365

Доброе время суток.
krosav4ig, а смысл в группировке? По счётчику СЧ таблицы1 все записи уникальны же

Вариант.
Код с функцией в VBA модуль
[vba]

Код

Private FSel As ADODB.Recordset

Public Function GetTable2List(ByVal X1, X2, X3) As String
    Dim sSQL As String, sResult As String
    If FSel Is Nothing Then Set FSel = New ADODB.Recordset: FSel.CursorLocation = adUseClient
    sSQL = "Select КОД From Таблица2 Where '" & X1 & "' Like IIF(IsNull(XX1) Or XX1 = '', '%', XX1)"
    sSQL = sSQL & " And '" & X2 & "' Like IIF(IsNull(XX2) Or XX2 = '', '%',  XX2)"
    sSQL = sSQL & " And '" & X3 & "' Like IIF(IsNull(XX3) Or XX3 = '', '%',  XX3) Order By 1"
    FSel.Open sSQL, Application.CurrentProject.Connection
    sResult = ""
    If FSel.RecordCount > 0 Then
        sResult = FSel(0).Value
        FSel.MoveNext
        Do Until FSel.EOF
            sResult = sResult & ", " & FSel(0).Value
            FSel.MoveNext
        Loop
    End If
    FSel.Close
    GetTable2List = sResult
End Function

[/vba]
SQL запрос
[vba]

Код

SELECT СЧ, X1, X2, X3, GetTable2List(X1, X2, X3) AS ИТОГ FROM Таблица1;

[/vba]
P. S. Если в каждой из таблиц будет строк так по 10000, то долго это всё будет работать. Про 100000 уже можно и уснуть

Сообщение отредактировал anvg - Суббота, 21.01.2017, 10:59

Ответить

Дата: Суббота, 21.01.2017, 14:58 | Сообщение № 4

Группа: Пользователи

Ранг: Новичок

Сообщений: 16

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

krosav4ig, Спасибо Огромное!!!
убрал условие не выводить пустой ИТОГ и это то что мне нужно!
не понимаю как оно работает, но попытаюсь теперь встроить это все в "основной" запрос на выборку

с Уважением, Владимир

Ответить

Дата: Суббота, 21.01.2017, 15:02 | Сообщение № 5

Группа: Пользователи

Ранг: Новичок

Сообщений: 16

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

anvg, Попробовал Ваш вариант, он тоже работает!
Спасибо!!!!!

с Уважением, Владимир

Ответить

Дата: Суббота, 21.01.2017, 16:42 | Сообщение № 6

Группа: Друзья

Ранг: Старожил

Сообщений: 2347

Репутация: 997 ±

Замечаний: 0% ±

Excel 2007,2010,2013

[offtop]

Цитата anvg, 21.01.2017 в 10:57, в сообщении № 3 ()

а смысл в группировке?

Без понятия, видимо мой моск уже спал в это время

[/offtop]

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Ответить

Дата: Воскресенье, 22.01.2017, 09:41 | Сообщение № 7

Группа: Друзья

Ранг: Ветеран

Сообщений: 581

Репутация: 271 ±

Замечаний: 0% ±

2016, 365

Доброе время суток
Если X1 и XX1 будут числовыми (целыми), то изменится строка запроса в функции GetTable2List (заодно убрал конструкцию с Like - в рамках логики она не нужна).
[vba]

Код

    sSQL = "Select КОД From Таблица2 Where IIF(IsNull(XX1), True, " & CStr(X1) & " = XX1)"
    sSQL = sSQL & " And IIF(IsNull(XX2) Or XX2 = '', True, '" & X2 & "' =  XX2)"
    sSQL = sSQL & " And IIF(IsNull(XX3) Or XX3 = '', True, '" & X3 & "' = XX3) Order By 1"

[/vba]
Успехов.

Ответить

Дата: Воскресенье, 22.01.2017, 16:17 | Сообщение № 8

Группа: Пользователи

Ранг: Новичок

Сообщений: 16

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

anvg, Спасибо, работает!
в тестовую базу скопировал реальные таблицу1 и таблицу2, поменял названия полей на реальные, все работает
копирую рабочий запрос и модуль из тестовой базы в реальную - не работает...
при выполнении запроса: "ошибка компиляции в выражении запроса ..."
может как-то по хитрому нужно копировать, а не просто CTRL+C, CTRL+V?
есть еще 1 ньюанс поле [Х1] реально называется [КОД ОПС] с пробелом, в модуле назвал его КОД_ОПС, может тут причина... но на тестовой же работает и так...

с Уважением, Владимир

Ответить

Дата: Воскресенье, 22.01.2017, 17:51 | Сообщение № 9

Группа: Друзья

Ранг: Ветеран

Сообщений: 581

Репутация: 271 ±

Замечаний: 0% ±

2016, 365

Цитата vole1977, 22.01.2017 в 16:17, в сообщении № 8 ()

реально называется [КОД ОПС] с пробелом

Тогда просто все названия полей таблиц в []
[vba]

Код

    sSQL = "Select [КОД] From Таблица2 Where IIF(IsNull([XX1]), True, " & CStr(X1) & " = [XX1])"
    sSQL = sSQL & " And IIF(IsNull([XX2]) Or [XX2] = '', True, '" & X2 & "' =  [XX2])"
    sSQL = sSQL & " And IIF(IsNull([XX3]) Or [XX3] = '', True, '" & X3 & "' = [XX3]) Order By 1"

[/vba]
и
[vba]

Код

SELECT [СЧ], [X1], [X2], [X3], GetTable2List([X1], [X2], [X3]) AS ИТОГ FROM Таблица1;

[/vba]

Ответить

Дата: Воскресенье, 22.01.2017, 19:31 | Сообщение № 10

Группа: Пользователи

Ранг: Новичок

Сообщений: 16

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

anvg, не получается
если править тут: " & CStr([Код ОПС]) & "
то нужно и тут так-же указать, а не дает
Public Function Get_DEF_SPETS_List(ByVal ВУС, КОД, Код ОПС) As String

реальные названия полей в модуле:

[vba]

Код

Private FSel As ADODB.Recordset
Public Function Get_DEF_SPETS_List(ByVal ВУС, КОД, Код ОПС) As String
Dim sSQL As String, sResult As String
If FSel Is Nothing Then Set FSel = New ADODB.Recordset: FSel.CursorLocation = adUseClient
sSQL = "Select [ДЕФ_СПЕЦ] From 3_ДЕФ_СПЕЦ Where IIF(IsNull([Код_ОПС_Д]), True, " & CStr([Код ОПС]) & " = [Код_ОПС_Д])"
sSQL = sSQL & " And IIF(IsNull([КОД_Д]) Or [КОД_Д] = '', True, '" & [КОД] & "' = [КОД_Д])"
sSQL = sSQL & " And IIF(IsNull([ВУС_Д]) Or [ВУС_Д] = '', True, '" & [ВУС] & "' = [ВУС_Д]) Order By 1"
FSel.Open sSQL, Application.CurrentProject.Connection
sResult = ""
If FSel.RecordCount > 0 Then
sResult = FSel(0).Value
FSel.MoveNext
Do Until FSel.EOF
sResult = sResult & ", " & FSel(0).Value
FSel.MoveNext
Loop
End If
FSel.Close
Get_DEF_SPETS_List = sResult
End Function

[/vba]

с Уважением, Владимир

Ответить

Дата: Воскресенье, 22.01.2017, 21:24 | Сообщение № 11

Группа: Друзья

Ранг: Ветеран

Сообщений: 581

Репутация: 271 ±

Замечаний: 0% ±

2016, 365

Вы путаете имена переменных в VBA функциях и передачу параметров в такие функции в SQL запросе
[vba]

Код

Private FSel As ADODB.Recordset
Public Function Get_DEF_SPETS_List(ByVal ВУС, ByVal КОД, ByVal Код_ОПС) As String
    Dim sSQL As String, sResult As String
    If FSel Is Nothing Then Set FSel = New ADODB.Recordset: FSel.CursorLocation = adUseClient
    sSQL = "Select [ДЕФ_СПЕЦ] From 3_ДЕФ_СПЕЦ Where IIF(IsNull([Код_ОПС_Д]), True, " & CStr(Код_ОПС) & " = [Код_ОПС_Д])"
    sSQL = sSQL & " And IIF(IsNull([КОД_Д]) Or [КОД_Д] = '', True, '" & КОД & "' = [КОД_Д])"
    sSQL = sSQL & " And IIF(IsNull([ВУС_Д]) Or [ВУС_Д] = '', True, '" & ВУС & "' = [ВУС_Д]) Order By 1"
    FSel.Open sSQL, Application.CurrentProject.Connection
    sResult = ""
    If FSel.RecordCount > 0 Then
        sResult = FSel(0).Value
        FSel.MoveNext
        Do Until FSel.EOF
            sResult = sResult & ", " & FSel(0).Value
            FSel.MoveNext
        Loop
    End If
    FSel.Close
    Get_DEF_SPETS_List = sResult
End Function

[/vba]
А вот вызов
[vba]

Код

SELECT *, GetTable2List([ВУС], [КОД], [Код ОПС]) AS ИТОГ FROM Таблица1;

[/vba]

Ответить

Дата: Воскресенье, 29.01.2017, 20:44 | Сообщение № 12

Группа: Пользователи

Ранг: Новичок

Сообщений: 16

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

anvg, Добрый вечер!
Ничего не получается... на тестовой базе работает, а при копировании в реальную ошибка
посмотрите пожалуйста вложение
что может быть не так?
Извините, что отвечаю только сегодня, раньше не получалось вернуться к этому вопросу

К сообщению приложен файл: test.7z (41.3 Kb)

с Уважением, Владимир

Ответить

Дата: Понедельник, 30.01.2017, 09:40 | Сообщение № 13

Группа: Друзья

Ранг: Ветеран

Сообщений: 581

Репутация: 271 ±

Замечаний: 0% ±

2016, 365

Доброе время суток

Цитата vole1977, 29.01.2017 в 20:44, в сообщении № 12 ()

а при копировании в реальную ошибка

Вы упорно добавляете [] вокруг переменных VBA

Успехов.

К сообщению приложен файл: Database_test.rar (25.1 Kb)

Ответить

Дата: Понедельник, 30.01.2017, 14:25 | Сообщение № 14

Группа: Пользователи

Ранг: Новичок

Сообщений: 16

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

anvg, Добрый день!
Ничего не поменялось... ошибка осталалась та-же...
что еще может быть не так?

с Уважением, Владимир

Ответить

Дата: Понедельник, 30.01.2017, 15:32 | Сообщение № 15

Группа: Друзья

Ранг: Старожил

Сообщений: 2347

Репутация: 997 ±

Замечаний: 0% ±

Excel 2007,2010,2013

vole1977, ну дык в VBE нужно тыкнуть галочку tools>references>microsoft activex data objects 2.8 library
или в коде заменить
[vba]

Код

Private FSel As ADODB.Recordset

[/vba] на [vba]

Код

Private FSel As object

[/vba] и[vba]

Код

If FSel Is Nothing Then Set FSel = New ADODB.Recordset: FSel.CursorLocation = adUseClient

[/vba] на [vba]

Код

If FSel Is Nothing Then Set FSel = createobject("ADODB.Recordset"): FSel.CursorLocation = 3

[/vba]

email:krosav4ig26@gmail.com WMR R207627035142 WMZ Z821145374535 ЯД 410012026478460

Ответить

Дата: Понедельник, 30.01.2017, 20:33 | Сообщение № 16

Группа: Друзья

Ранг: Ветеран

Сообщений: 581

Репутация: 271 ±

Замечаний: 0% ±

2016, 365

Да, коллега krosav4ig, прав. Видимо у вас библиотека Microsoft ActiveX Data Objects в рабочей базе не подключена. У меня после удаления ][ - запрос и функция отработали. Хотя сообщение об ошибке вы приводили странное.

Сообщение отредактировал anvg - Понедельник, 30.01.2017, 20:33

Ответить

Дата: Вторник, 31.01.2017, 10:39 | Сообщение № 17

Группа: Пользователи

Ранг: Новичок

Сообщений: 16

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

krosav4ig, Спасибо!
поставил галочку и все заработало!

с Уважением, Владимир

Ответить

Access2010 запрос на выборку (пример во вложении не знаю как кратко сформулировать задачу)

Страница 1 из 1
1

© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!