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

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

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

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

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

Ответ
 
Опции темы Поиск в этой теме
Старый 21.04.2017, 10:11   #1
Maniac Rabbit
Пользователь
 
Аватар для Maniac Rabbit
 
Регистрация: 20.04.2017
Сообщений: 11
По умолчанию Функция поиска на листах (аналог ВПР)

Доброе время суток!
Пишу функцию (некоторый аналог ВПР), которая должна искать в разных книгах коды ( по типу как id) и в случае успешного
поиска то подтягивать по коду значения.
При выполнении возникает ошибка 1004 "Application-defined or object-defined error"
Ругается на строку кода
PHP код:
 For Each RngTable In MyXL.Sheets(SheetNumFROM).Range(Cells(RowAKTClmAKT), Cells(lLastRow_AKTClmAKT)) 
Вот код функции:
PHP код:
Option Base 1
Public Type Codes
    Kv 
As Variant    '-Квартал
    vydel As Variant '
-Выдел
    plosh 
As Variant '-Площадь
    kod As Variant   '
-Шифр
End Type

'Функция для поиска кодов на листе "Поиск"
'
Возвращает диапазон с описанием кода
'Входные параметры:
'
textParth-Путь до рабочей книги
'SheetNumFROM-это  лист с исходными данными
'
SheetNum_KODлист поиска содержащий коды
'RowAKT-Строка от которой начинаются исходные данные
'
ClmAKT-Колонка от которой начинаются данные


Function FindIN_AKT_PLY(ByVal textParth As StringSheetNumFROM As Integer_
SheetNum_KOD 
As IntegerRowAKT As IntegerClmAKT As Integer) As Range
Dim MyXL 
As Object
Dim RngTable 
As RangeRngAreaTable As Range
Dim Count 
As Integer
Dim wbNameLocal 
As String
Dim arrays
() As Codes '- Массив пользовательского типа
    
    Application.DisplayAlerts = False
    wbNameLocal = ActiveWorkbook.Name '
Записываем название открытой книги (для операции с листами)
    
Set MyXL CreateObject(textParth'- Создаем объект типа Exel Application
    Count = 0 '
Локальная переменная счетчика (сколько объектов нашли)
    
itemp '- Переменная счетчика массива
    lLastRow_AKT = FindLRow(SheetNumFROM) '
Функция возвращает последнюю строку листа с исходными данными
    lLastRow_KOD 
FindLRow(SheetNum_KOD'- Функция возвращает последнюю строку листа поиска
    For Each RngTable In MyXL.Sheets(SheetNumFROM).Range(Cells(RowAKT, ClmAKT), Cells(lLastRow_AKT, ClmAKT)) '
Диапазон столбца "КОД" на листе с исходными данными
             Set RngAreaTable 
Workbooks(" " wbNameLocal ""). _
             Sheets
(SheetNum_KOD).Range(Cells(11), Cells(lLastRow_KOD1)) '- Обращение к листу с кодами
             Set FindIN_AKT_PLY = RngAreaTable.Find(RngTable.Value, _
             , xlValues, LookAt:=xlWhole) '
Сам поиск ищет совпадения по коду
             
If Not FindIN_AKT_PLY Is Nothing Then
                    Data_insert 
FindIN_AKT_PLY.Offset(01).Value '- В случае если коды совпали подтягиваю шифр
                    '
Переносим Код
                    
'Код- INSERT TO Массив типа Codes
                    ReDim arrays(itemp)
                    arrays(itemp).kod = FindIN_AKT_PLY.Value
                    '
Переносим Квартал
                    
'Квартал- INSERT TO Массив типа Codes
                    '
Значение получаем за счет смещения колонки на листе с исходными данными
                    ReDim arrays
(itemp 1'- Увеличиваем число эл-в в массиве на 1-цу
                    arrays(itemp).Kv = RngTable.Offset(0, -2).Value
                    '
Переносим Выдел
                    
'Выдел- INSERT TO Массив типа Codes
                    '
Значение получаем за счет смещения колонки на листе листе с исходными данными
                    ReDim arrays
(itemp 1)
                    
arrays(itemp).vydel RngTable.Offset(0, -1).Value
                    
'- Переносим Выдел
                    '
ВыделINSERT TO Массив типа Codes
                    
'Значение получаем за счет смещения колонки на листе листе с исходными данными
                    ReDim arrays(itemp + 1)
                    arrays(itemp).plosh = RngTable.Offset(0, -1).Value
                    '
Переносим Площадь
                    
'Площадь- INSERT TO Массив типа Codes
                    '
Значение получаем за счет смещения колонки на листе листе с исходными данными
                    itemp 
itemp 1
                    Count 
Count 1
             End 
If
    
Next RngTable
    
If Count 0 Then
            MsgBox 
"Данные не найдены"vbExclamation
        
Else
            
MsgBox "Сведенья перенесены " vbNewLine " в количестве: " Count " штук." vbNewLine "Рекомендуется проверить данные"vbInformation
        End 
If
    
    
Set MyXL Nothing
    Application
.DisplayAlerts True
    
End 
Function 
Вот процедура, в которой вызывается данная функция
PHP код:
'Главная процедура выполнения поиска, запускается по кнопке
'
TextData путь до книги на которой содержаться исходные данные!
'Необходимо поменять путь на свой, для примера заморачиваться и создавать Filediag не стал
Sub Check_Sub()
Dim TextData As String
    
    TextData = "C:\Users\Admins\Desktop\Тест_USER_ARR_2.xlsm"
    Call FindIN_AKT_PLY(TextData, 2, 3, _
    2, 3)
End Sub 
П.С.
CreateObject - необходим, потому что пользователи указывают путь и будут работать с не открытой книгой
Полный пример во вложении
Вложения
Тип файла: rar Тест_USER_ARR_2.rar (34.4 Кб, 5 просмотров)
Maniac Rabbit вне форума Ответить с цитированием
Старый 21.04.2017, 11:24   #2
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

предположу что процедура не знает к чему относятся CELLSы.
Код:
Cells(RowAKT, ClmAKT), Cells(lLastRow_AKT, ClmAKT)
Надобно точнее указать к какому листу
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 22.04.2017, 08:27   #3
Maniac Rabbit
Пользователь
 
Аватар для Maniac Rabbit
 
Регистрация: 20.04.2017
Сообщений: 11
По умолчанию

Я уже и так пробовал:
Код:
Set RangeALLD = ActiveWorkbook.Sheets(SheetNumFROM).Range(Cells(RowAKT, ClmAKT), Cells(lLastRow_AKT, ClmAKT))
И так:
Код:
Set RangeALLD = Workbooks("Тест_USER_ARR_2.xlsm").Sheets(SheetNumFROM).Range(Cells(RowAKT, ClmAKT), Cells(lLastRow_AKT, ClmAKT))
Все равно ошибка
Maniac Rabbit вне форума Ответить с цитированием
Старый 22.04.2017, 14:37   #4
IgorGO
Новичок
СтарожилДжуниор
 
Аватар для IgorGO
 
Регистрация: 05.02.2008
Сообщений: 9,487
По умолчанию

у Вас случайно начальная и конечная ячейка не принадлежат разным листам?
если да, такой диапазон обьявить не возможно.
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете
IgorGO вне форума Ответить с цитированием
Старый 22.04.2017, 14:59   #5
Maniac Rabbit
Пользователь
 
Аватар для Maniac Rabbit
 
Регистрация: 20.04.2017
Сообщений: 11
По умолчанию

Цитата:
Сообщение от IgorGO Посмотреть сообщение
начальная и конечная ячейка не принадлежат разным листам
Это как? Обращаюсь к ячейкам
К примеру:
Код:
Set RangeALLD = Workbooks("Тест_USER_ARR_2.xlsm").Worksheets("Данные").Range(Cells(RowAKT, ClmAKT), Cells(lLastRow_AKT, ClmAKT))
RowAKT, ClmAKT, lLastRow_AKT,ClmAKT - переменные в которые передаются значения для диапазона. Грубо говоря туда передается следующее (Range(Cells(2,3),Cells(13,3)) то есть целый столбец "C" на листе данные.
Maniac Rabbit вне форума Ответить с цитированием
Старый 22.04.2017, 22:19   #6
Maniac Rabbit
Пользователь
 
Аватар для Maniac Rabbit
 
Регистрация: 20.04.2017
Сообщений: 11
По умолчанию

Нашел решение, добавил
Код:
Sheets(SheetNumFROM).Activate
Перед выполнением цикла. Можно обращаться к диапазонам разных листов без активации самого листа?
Maniac Rabbit вне форума Ответить с цитированием
Старый 24.04.2017, 15:05   #7
Maniac Rabbit
Пользователь
 
Аватар для Maniac Rabbit
 
Регистрация: 20.04.2017
Сообщений: 11
По умолчанию

Чтобы не скакать по листам во время выполнения цикла нужно добавить так:
Код:
Range(Sheets(SheetNumFROM).Cells(RowAKT, ClmAKT), Sheets(SheetNumFROM).Cells(lLastRow_AKT, ClmAKT))
Это если использовать метод cells, при просто Range("A...") указывать постоянно листы не нужно.
Maniac Rabbit вне форума Ответить с цитированием
Старый 24.04.2017, 15:07   #8
Maniac Rabbit
Пользователь
 
Аватар для Maniac Rabbit
 
Регистрация: 20.04.2017
Сообщений: 11
Хорошо

Цитата:
Сообщение от Maniac Rabbit Посмотреть сообщение
Чтобы не скакать по листам во время выполнения цикла нужно добавить так:
Код:
Range(Sheets(SheetNumFROM).Cells(RowAKT, ClmAKT), Sheets(SheetNumFROM).Cells(lLastRow_AKT, ClmAKT))
Это если использовать метод cells, при просто Range("A...") указывать постоянно листы не нужно.
Спасибо! Помог,то что нужно!
Maniac Rabbit вне форума Ответить с цитированием
Старый 24.04.2017, 19:28   #9
Aleksandr H.
2 the Nation Glory
Старожил
 
Аватар для Aleksandr H.
 
Регистрация: 27.05.2014
Сообщений: 3,289
По умолчанию

Цитата:
Сообщение от Maniac Rabbit Посмотреть сообщение
Чтобы не скакать по листам во время выполнения цикла нужно добавить так:
Ну а я тебе во 2м сообщении разве не написал, чтобы точнее указал с какого листа нужно ячейки те брать?

Сообщение №8 раздвоение личности?
Кто умер, но не забыт, тот бессмертен.
Лао-Цзы.
Aleksandr H. вне форума Ответить с цитированием
Старый 24.04.2017, 21:47   #10
Maniac Rabbit
Пользователь
 
Аватар для Maniac Rabbit
 
Регистрация: 20.04.2017
Сообщений: 11
По умолчанию

Видимо я не совсем понял тогда
Maniac Rabbit вне форума Ответить с цитированием
Ответ


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

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

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


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
аналог ВПР для больших таблиц yurinek Помощь студентам 1 06.02.2017 15:58
Функция ВПР tubus1993 Microsoft Office Excel 3 26.11.2012 17:58
Функция ВПР Nasten'ka7 Microsoft Office Excel 16 28.08.2012 16:11
Аналог ВПР или поиск текста bel1ever Microsoft Office Excel 3 19.08.2011 10:02
Функция ВПР Foxx Microsoft Office Word 3 14.03.2010 16:53