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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 29.05.2019, 19:40   #1
Vladimir_Der
Пользователь
 
Регистрация: 10.12.2018
Сообщений: 23
По умолчанию Поиск конца БД

Уважаемые пользователи Excel и VBA, окажите помощь!
Раньше для поиска конца БД использовал код ...Range("G9:H9").Select
Range(Selection, Selection.End(xlDown)).Select..., далее копирование и вставка куда укажу (для таблиц без заранее написанных формул).
В данный момент есть таблица в которую заносятся данные выборки из БД по определенному критерию, и в каждой ячейке таблицы прописаны формулы, при использовании данного кода выделяются все ячейки таблицы.
Подскажите пожалуйста, как сделать чтобы выделялись ячейки только с видимыми реальными данными, а не вместе с пустыми ячейками где прописаны формулы?
Заранее благодарен, файл аналога базы прилагается.
Вложения
Тип файла: rar Тест1.rar (15.0 Кб, 11 просмотров)

Последний раз редактировалось Vladimir_Der; 29.05.2019 в 19:54.
Vladimir_Der вне форума Ответить с цитированием
Старый 30.05.2019, 12:28   #2
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Код:
Sub SelectAllNonBlankCells()
    Dim objUsedRange As Range
    Dim objRange As Range
    Dim objNonblankRange As Range

    Set objUsedRange = Range("G9:H" & Range("H" & Rows.Count).End(xlUp).Row)

    For Each objRange In objUsedRange
        If Not (objRange.Value = "") Then
           If objNonblankRange Is Nothing Then
              Set objNonblankRange = objRange
           Else
              Set objNonblankRange = Application.Union(objNonblankRange, objRange)
           End If
        End If
    Next

    If Not (objNonblankRange Is Nothing) Then
       objNonblankRange.Select
    End If
End Sub
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 01.06.2019, 21:36   #3
Vladimir_Der
Пользователь
 
Регистрация: 10.12.2018
Сообщений: 23
По умолчанию

Александр огромное спасибо! Опять меня выручили здорово, все работает как надо.
На эту же тему есть еще вопрос " Выборка данных из базы с помощью автофильтров", при нахождении в БД по заданным параметрам автофильтров более одной строки копирование проходит без проблем.
Но если находится только одна строка с данным или ни одной, происходит выделение и копирование всех строк ниже заголовков таблицы до конца возможностей Excel, вот используемый код:
имя листа.Visible = True
имя листа.Select
ActiveSheet.Unprotect Password:="123"
Range("F20").Value = ComboBox1.Text
Selection.AutoFilter Field:=6, Operator:=xlFilterValues, Criteria1:="=" & Range("F20").Value
Selection.AutoFilter Field:=14, Criteria1:= _
Array("доски", "арматура", "и т.д."), Operator:=xlFilterValues

Selection.AutoFilter Field:=22, Criteria1:= _
"пятница"
Selection.AutoFilter Field:=28, Criteria1:= _
"<>"
Selection.AutoFilter Field:=32, Criteria1:= _
"="

Range("AE40").Select
Range(Selection, Selection.End(xlDown)).Select 'выбор конца бд
Selection.Copy
Sheets("имя листа другого").Select
Range("B6").Select
ActiveSheet.Paste

Заранее благодарен!
Vladimir_Der вне форума Ответить с цитированием
Старый 03.06.2019, 10:34   #4
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

https://stackoverflow.com/questions/...fter-filtering
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Не до конца доходит dt,dd,dl AnweeKey HTML и CSS 4 19.09.2018 22:35
Искать до конца exivmaks C# (си шарп) 1 13.04.2015 10:45
Поиск начала и конца слова в Паскале Iliyabond Паскаль, Turbo Pascal, PascalABC.NET 1 12.03.2014 17:42
поиск конца слова... C# Odyssey C# (си шарп) 5 01.04.2012 20:26