Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Excel
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 17.10.2016, 22:02   #1
Raymond86
 
Регистрация: 12.01.2016
Сообщений: 7
По умолчанию Подстановка с 3-х листов на 4-ый с удалением дубликатов

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

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

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

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

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

Вопрос в том, что последней записью почему то в итоговой таблице ставится почему то текст с заголовка таблицы на листе LETTRS CHECK...((( Как от этого избавиться? Помогите пож-ста...

Может есть альтернативный способ собирать даты с листов другим кодом?
Вложения
Тип файла: rar Проба1.rar (113.0 Кб, 12 просмотров)

Последний раз редактировалось Raymond86; 17.10.2016 в 23:23.
Raymond86 вне форума Ответить с цитированием
Старый 18.10.2016, 08:14   #2
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

если последняя строка неинформативная, просто удаляйте ее
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 18.10.2016, 09:13   #3
Step_UA
Форумчанин
 
Аватар для Step_UA
 
Регистрация: 09.06.2011
Сообщений: 388
По умолчанию

Цитата:
Сообщение от Raymond86 Посмотреть сообщение
Вопрос в том, что последней записью почему то в итоговой таблице ставится почему то текст с заголовка таблицы на листе LETTRS CHECK...((( Как от этого избавиться?
Допущена ошибка в вычислении последней строки таблиц (посмотрите на принимаемые значения соответствующих переменных по F8 в дебагере):
- если записей 2 и более, то последняя не участвует в выборке
- если запись 1, то участвует также заголовок
на неконкретные вопросы даю неконкретные ответы ...
Step_UA вне форума Ответить с цитированием
Старый 18.10.2016, 22:46   #4
Raymond86
 
Регистрация: 12.01.2016
Сообщений: 7
По умолчанию

Цитата:
Сообщение от Step_UA Посмотреть сообщение
Допущена ошибка в вычислении последней строки таблиц (посмотрите на принимаемые значения соответствующих переменных по F8 в дебагере):
- если записей 2 и более, то последняя не участвует в выборке
- если запись 1, то участвует также заголовок

мне бы еще понять, какая это ошибка....(( к сожалению непонятно, что надо поправить, чтобы работало.
Raymond86 вне форума Ответить с цитированием
Старый 19.10.2016, 08:19   #5
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Цитата:
Сообщение от Raymond86 Посмотреть сообщение
мне бы еще понять, какая это ошибка....(( к сожалению непонятно, что надо поправить, чтобы работало.
Код:
Sheets("VGR").Select
    asd = ActiveCell.Worksheet.Cells.SpecialCells(xlCellTypeLastCell).Row - 1
    Sheets("CLAIMS CHECK").Select
    dfg = ActiveCell.Worksheet.Cells.SpecialCells(xlCellTypeLastCell).Row - 1
    Sheets("LETTERS CHECK").Select
    lett = ActiveCell.Worksheet.Cells.SpecialCells(xlCellTypeLastCell).Row - 1
Зачем "-1" ? На листе LettersCheck данные только в 10 строке, берете -1 и получается что в запрос пойдет диапазон 9:10 строк
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 19.10.2016, 14:58   #6
Raymond86
 
Регистрация: 12.01.2016
Сообщений: 7
По умолчанию

Цитата:
Сообщение от Aleksandr H. Посмотреть сообщение

Зачем "-1" ? На листе LettersCheck данные только в 10 строке, берете -1 и получается что в запрос пойдет диапазон 9:10 строк
"-1" я уже убрал))) дописал в код условие.

Код:
Sheets("VGR").Select
asd = ActiveCell.Worksheet.Cells.SpecialCells(xlCellTypeLastCell).Row
If asd < 10 Then asd = 10
Sheets("CLAIMS CHECK").Select
dfg = ActiveCell.Worksheet.Cells.SpecialCells(xlCellTypeLastCell).Row
If dfg < 10 Then dfg = 10
Sheets("LETTERS CHECK").Select
lett = ActiveCell.Worksheet.Cells.SpecialCells(xlCellTypeLastCell).Row
If lett < 10 Then lett = 10

вот теперь дата с 3-го листа LETTERS CHECK почему-то не берется.
Вложения
Тип файла: rar Проба 3.rar (168.6 Кб, 8 просмотров)

Последний раз редактировалось Raymond86; 19.10.2016 в 15:02.
Raymond86 вне форума Ответить с цитированием
Старый 19.10.2016, 18:05   #7
Raymond86
 
Регистрация: 12.01.2016
Сообщений: 7
По умолчанию

Подскажите пож-ста, не могу разобраться...(((
Raymond86 вне форума Ответить с цитированием
Старый 19.10.2016, 23:05   #8
Step_UA
Форумчанин
 
Аватар для Step_UA
 
Регистрация: 09.06.2011
Сообщений: 388
По умолчанию

Цитата:
Сообщение от Raymond86 Посмотреть сообщение
"-1" я уже убрал))) дописал в код условие.
вот теперь дата с 3-го листа LETTERS CHECK почему-то не берется.
Вы ведь не только убрали -1, но и изменили сам запрос: ранее выборка начиналась с 10 строки ... все работает согласно запросу
Предполагаю, что результат не тот который ожидался, но какой нужен вы не указывали, а телепатов нет
на неконкретные вопросы даю неконкретные ответы ...
Step_UA вне форума Ответить с цитированием
Старый 19.10.2016, 23:13   #9
Raymond86
 
Регистрация: 12.01.2016
Сообщений: 7
По умолчанию

Цитата:
Сообщение от Step_UA Посмотреть сообщение
Вы ведь не только убрали -1, но и изменили сам запрос: ранее выборка начиналась с 10 строки ... все работает согласно запросу
Предполагаю, что результат не тот который ожидался, но какой нужен вы не указывали, а телепатов нет
Как это не указывал? В первом посте указывалось, что ожидается от кода:

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

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

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

Вопрос сейчас в том, что дата с 3-го листа LETTERS CHECK почему-то не берется.

ну, хорошо и заново файл))) Заранее спасибо))
Вложения
Тип файла: rar Проба 3.rar (98.9 Кб, 4 просмотров)
Raymond86 вне форума Ответить с цитированием
Старый 19.10.2016, 23:43   #10
Step_UA
Форумчанин
 
Аватар для Step_UA
 
Регистрация: 09.06.2011
Сообщений: 388
По умолчанию

Код то изначально был правильный, только за исключением определения последней строки ... и не включать запросы к пустым таблицам
Код:
Sub Upd_Claims()

'ActiveWorkbook.RefreshAll
Dim endRow As Long, sqlStr1$
    endRow = Sheets("CLAIMS CHECK").Cells.SpecialCells(xlCellTypeLastCell).Row
    If endRow >= 10 Then sqlStr1 = "SELECT [f1] FROM [CLAIMS CHECK$g10:g" & endRow & "]"

    endRow = Sheets("VGR").Cells.SpecialCells(xlCellTypeLastCell).Row
    If endRow >= 10 Then
        If sqlStr1 <> "" Then sqlStr1 = sqlStr1 & " Union all"
        sqlStr1 = sqlStr1 & " SELECT [f1] FROM [VGR$d10:d" & endRow & "]"
    End If
    
    If endRow >= 10 Then
        If sqlStr1 <> "" Then sqlStr1 = sqlStr1 & " Union all"
        sqlStr1 = sqlStr1 & " SELECT [f1] FROM [LETTERS CHECK$h10:h" & endRow & "]"
    End If
    
    Sheets("STATISTICS").Select
    ' при необходимости очистки таблицы раскомментировать следующие строки
    'With Range("Таблица2").ListObject
    '    If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete
    'End With

    If sqlStr1 <> "" Then
      Dim objConnection As Object, rs As Object
 
        Set objConnection = CreateObject("ADODB.Connection")
        Set rs = CreateObject("ADODB.Recordset")
        objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                "Data Source=" & ActiveWorkbook.Path & "/" & ActiveWorkbook.Name & ";" & _
                "Extended Properties=""Excel 12.0;HDR=No"";"
 
        sqlStr1 = "SELECT a4.[f1] FROM (" & sqlStr1 & " ) AS a4"
        sqlStr1 = sqlStr1 & " GROUP BY a4.[f1]"
        sqlStr1 = sqlStr1 & " ORDER BY a4.[f1]"
 
        rs.Open sqlStr1, objConnection, 3, 3
        Sheets("Statistics").Cells(9, 2).CopyFromRecordset rs
 
        Set rs = Nothing
        Set objConnection = Nothing
    Else
        MsgBox "Данные отсутствуют"
    End If

End Sub
на неконкретные вопросы даю неконкретные ответы ...

Последний раз редактировалось Step_UA; 19.10.2016 в 23:51. Причина: Добавление кода очистки таблицы
Step_UA вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
объединение с удалением aer13 Microsoft Office Excel 6 23.11.2013 22:47
Проблема с удалением дубликатов strannick Microsoft Office Excel 19 28.09.2013 18:08
Сбор данных из нескольких листов на один с удалением дубликатов, но суммированием значений strannick Microsoft Office Excel 4 10.04.2012 19:18
поиск дубликатов файлов(имя, тип, размер). Вывод дубликатов на экран с отображением их пути faraon1792 Помощь студентам 4 19.03.2010 23:46
Ошибка с удалением pr1de БД в Delphi 1 08.05.2007 03:44