Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

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

 

= Мир MS Excel/Подстановка с 3-х листов на 4-ый с удалением дубликатов - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Подстановка с 3-х листов на 4-ый с удалением дубликатов (Макросы/Sub)
Подстановка с 3-х листов на 4-ый с удалением дубликатов
Raven2009 Дата: Среда, 19.10.2016, 22:42 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 51
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Доброго времени суток))

У меня возникла загвоздка с кодом.

В файле на листе Statistics на кнопке написан код с запросом, который собирает с листов даты:

- VGR - с колонки "Дата создания" (D :D )
- CLAIMS CHECK - "Дата создания" (G:G)
- LETTERS CHECK - "Дата претензии по письму" (H:H)

он их собирает, удаляет дубликаты, подставляет в первую колонку таблицы на листе Statistics и сортирует по возрастанию.

Вопрос в том, что дата с 3-го листа LETTERS CHECK почему-то не берется. И возможно еще, чтобы учитывалось, что на каком нибудь листе могут данные осутствовать? То есть тогда бы это пропускалось, а остальные данные подставлялись бы....

Может есть альтернативный способ собирать даты с листов другим кодом, если невозможно поправить этот код?
К сообщению приложен файл: _3.rar(99Kb)
 
Ответить
СообщениеДоброго времени суток))

У меня возникла загвоздка с кодом.

В файле на листе Statistics на кнопке написан код с запросом, который собирает с листов даты:

- VGR - с колонки "Дата создания" (D :D )
- CLAIMS CHECK - "Дата создания" (G:G)
- LETTERS CHECK - "Дата претензии по письму" (H:H)

он их собирает, удаляет дубликаты, подставляет в первую колонку таблицы на листе Statistics и сортирует по возрастанию.

Вопрос в том, что дата с 3-го листа LETTERS CHECK почему-то не берется. И возможно еще, чтобы учитывалось, что на каком нибудь листе могут данные осутствовать? То есть тогда бы это пропускалось, а остальные данные подставлялись бы....

Может есть альтернативный способ собирать даты с листов другим кодом, если невозможно поправить этот код?

Автор - Raven2009
Дата добавления - 19.10.2016 в 22:42
krosav4ig Дата: Четверг, 20.10.2016, 04:04 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 1334
Репутация: 533 ±
Замечаний: 0% ±

Excel 2007, 2013
Можно как-то так [vba]
Код
Sub Upd_Claims()
    'ActiveWorkbook.RefreshAll
    Dim objConnection As Object
    Dim rs As Object
    Dim arr$(3)
    arr(1) = "VGR$" & [Таблица_ClaimsOtherTotal.accdb[[#All],[Дата создания]]].Address(0, 0)
    arr(2) = "CLAIMS CHECK$" & [Таблица_ClaimsTotal.accdb[[#All],[Дата создания]]].Address(0, 0)
    arr(3) = "LETTERS CHECK$" & [Таблица_Letters_Total.accdb[[#All],[ДатаПретензииПоПисьму]]].Address(0, 0)
    Set objConnection = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & _
    ActiveWorkbook.FullName & ";" & "Extended Properties=""Excel 12.0;HDR=Yes"";"
    sqlStr1 = "Select DISTINCT * from (" & Mid(Join(arr, "] union all SELECT * from ["), 13) & "])"
    rs.Open sqlStr1, objConnection, 3, 3
    [Таблица2].ListObject.HeaderRowRange(2, 1).CopyFromRecordset rs
    Set rs = Nothing
    Set objConnection = Nothing
    Sheets("STATISTICS").Select
End Sub
[/vba]


(_)Õvõ(_)

Сообщение отредактировал krosav4ig - Четверг, 20.10.2016, 04:30
 
Ответить
СообщениеМожно как-то так [vba]
Код
Sub Upd_Claims()
    'ActiveWorkbook.RefreshAll
    Dim objConnection As Object
    Dim rs As Object
    Dim arr$(3)
    arr(1) = "VGR$" & [Таблица_ClaimsOtherTotal.accdb[[#All],[Дата создания]]].Address(0, 0)
    arr(2) = "CLAIMS CHECK$" & [Таблица_ClaimsTotal.accdb[[#All],[Дата создания]]].Address(0, 0)
    arr(3) = "LETTERS CHECK$" & [Таблица_Letters_Total.accdb[[#All],[ДатаПретензииПоПисьму]]].Address(0, 0)
    Set objConnection = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & _
    ActiveWorkbook.FullName & ";" & "Extended Properties=""Excel 12.0;HDR=Yes"";"
    sqlStr1 = "Select DISTINCT * from (" & Mid(Join(arr, "] union all SELECT * from ["), 13) & "])"
    rs.Open sqlStr1, objConnection, 3, 3
    [Таблица2].ListObject.HeaderRowRange(2, 1).CopyFromRecordset rs
    Set rs = Nothing
    Set objConnection = Nothing
    Sheets("STATISTICS").Select
End Sub
[/vba]

Автор - krosav4ig
Дата добавления - 20.10.2016 в 04:04
Raven2009 Дата: Четверг, 20.10.2016, 23:06 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 51
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Можно как-то так


Спасибо))) кажется, подойдет))) опробую и отпишусь)))
 
Ответить
Сообщение
Можно как-то так


Спасибо))) кажется, подойдет))) опробую и отпишусь)))

Автор - Raven2009
Дата добавления - 20.10.2016 в 23:06
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Подстановка с 3-х листов на 4-ый с удалением дубликатов (Макросы/Sub)
Страница 1 из 11
Поиск:

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