Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBA
Войти
Регистрация
Восстановить пароль
 
RomSam
3 / 3 / 3
Регистрация: 11.06.2013
Сообщений: 38
#1

Функция поиска данных и массив пользовательского типа - VBA

21.04.2017, 10:11. Просмотров 126. Ответов 0
Метки нет (Все метки)

Доброе время суток!
Пишу функцию (некоторый аналог ВПР), которая должна искать в разных книгах коды ( по типу как id) и в случае успешного
поиска то подтягивать по коду значения.
При выполнении возникает ошибка 1004 "Application-defined or object-defined error"
Ругается на строку кода
Visual Basic
1
 For Each RngTable In MyXL.Sheets(SheetNumFROM).Range(Cells(RowAKT, ClmAKT), Cells(lLastRow_AKT, ClmAKT))
Вот код функции:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
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 String, SheetNumFROM As Integer, _
SheetNum_KOD As Integer, RowAKT As Integer, ClmAKT As Integer) As Range
Dim MyXL As Object
Dim RngTable As Range, RngAreaTable 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 = 1 '- Переменная счетчика массива
    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(1, 1), Cells(lLastRow_KOD, 1)) '- Обращение к листу с кодами
             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(0, 1).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
Вот процедура, в которой вызывается данная функция
Visual Basic
1
2
3
4
5
6
7
8
9
10
'Главная процедура выполнения поиска, запускается по кнопке
'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 - необходим, потому что пользователи указывают путь и будут работать с не открытой книгой
Полный пример во вложении
0
Вложения
Тип файла: rar Тест_USER_ARR_2.rar (34.4 Кб, 1 просмотров)
Надоела реклама? Зарегистрируйтесь и она исчезнет полностью.
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
21.04.2017, 10:11
Я подобрал для вас темы с готовыми решениями и ответами на вопрос Функция поиска данных и массив пользовательского типа (VBA):

Динамический массив для хранения данных в переменной пользовательского типа
С пользовательским типом вродь разобралась, а вот с динамическим массивом не...

Передача массива данных пользовательского типа
всем привет, пытаюсь передать в пользовательскую функцию в качестве...

Передача массива данных пользовательского типа в качестве аргумента функции
Добрый день! массив ParamArray всегда имеет тип данных Variant В функцию...

Массив пользовательского типа - объект для хранения именованных переменных и массивов различных размерностей с максимальной скоростью доступа
Недавно открыл для своих целей всю мощь такого объекта. Решил поделиться. ...

Запись данных в таблицу по условию/функция поиска
Добрый день ув. знатоки VBA! Есть две колонки: в первую по порядку заносятся...

ListBox: Как передать данные из пользовательского типа?
Привет! Подскажите, пожалуйста. Следующая ситуация: Есть своя...

0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
21.04.2017, 10:11
Привет! Вот еще темы с решениями:

Передача в функцию массива элементов пользовательского типа
Элементов, конечно, извините. Не могу понять сообщения об ошибке Type myType...

Как присвоить значения полям переменной пользовательского типа?
----------- Public Type MyType val_1 As Byte val_2 As Single End Type...

Функция, которая принимает аргумент типа String и возвращает результат типа Double
Написать функцию, которая принимает аргумент типа String, и возвращает...

В переменную какого типа можно запихнуть двумерный массив типа String
тип Variant это правильно или можно урезать? Waches показывает тип массива...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
1
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru