Подстановка с 3-х листов на 4-ый с удалением дубликатов

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

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

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Подстановка с 3-х листов на 4-ый с удалением дубликатов (Макросы/Sub)

Raven2009

Дата: Среда, 19.10.2016, 22:42 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 151

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

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

Excel 2013

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

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

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

- VGR - с колонки "Дата создания" (D

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

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

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

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

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

Ответить

krosav4ig

Дата: Четверг, 20.10.2016, 04:04 | Сообщение № 2

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

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

Сообщений: 2347

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

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

Excel 2007,2010,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]

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

Сообщение отредактировал krosav4ig - Четверг, 20.10.2016, 04:30

Ответить

Raven2009

Дата: Четверг, 20.10.2016, 23:06 | Сообщение № 3

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 151

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

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

Excel 2013

Цитата krosav4ig, 20.10.2016 в 04:04, в сообщении № 2

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

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

Ответить

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