Создать функцию для выбора по условию и сцепления значений без повторов

@Shuret · Регистрация: 27.06.2012

Студворк — интернет-сервис помощи студентам

Здравствуйте. ситуация такая. существуют две книги Эксель. в одной каталог материалов, во второй БД для слияния. нужно создать функцию, которая сравнивнит значения в нескольких ячейках со значением другой ячейки, затем выберет совпадения и вернет значения, которые подходят под совпавшие из другой книги.

я очень далека от программирования, но как-то так.

на примере: нужно сравнить поля труба_ст_2(3,4)_серт с труба_ст_1_серт и при повторе вызвать значения труба_ст_1(2,3,4).

В результате должно получится
Сертификат №466 на ст.трубы Ø25х3,2 от 18.03.2010г.
Сертификат №416 на ст.трубы Ø15х2,8; Ø20х2,8; Ø50х3,5 от 11.03.2010г.
Сертификат №753 на ст.трубы Ø32х3,2 от 24.06.2009г.
Сертификат №1100 на ст.трубы Ø76х3,5 от 05.08.2009г.

(создать функцию для подчеркнутого текста)

при этом не всегда все ячейки будут заполнены, соответственно зависящие от них функции будут выдавать ошибки.
Помогите пожалуйста!!!

@Alex77755 · 28.06.2012, 00:53

поправлю

Добавлено через 5 минут
наслаждайся:

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
Function Группировать_сертификаты(Строка_данных As Range, _
Optional Наименование As String, Optional Знак As String) As String
Dim C
Dim S As String
Dim M()
Dim Stroka As String
Dim oDict: Set oDict = CreateObject("Scripting.Dictionary")  ' Создаем словарь
For C = 2 To Строка_данных.Columns.Count Step 3
    If Строка_данных.Cells(1, C - 1).Value <> Empty Then
        Stroka = Left(Строка_данных.Cells(1, C).Value, Len(Строка_данных.Cells(1, C).Value) - 17) & Наименование & " " & Знак
            If oDict.Exists(Строка_данных.Cells(1, C).Value) Then
                oDict.Item(Строка_данных.Cells(1, C).Value) = oDict.Item(Строка_данных.Cells(1, C).Value) & "; " & Знак & Строка_данных.Cells(1, C - 1).Value
            Else
                oDict.Add Строка_данных.Cells(1, C).Value, Stroka & Строка_данных.Cells(1, C - 1).Value
            End If
    End If
Next C
M = oDict.keys
For C = 0 To oDict.Count - 1
 S = S & oDict.Item(M(C)) & " " & Right(M(C), 17) & vbCrLf
Next C
Группировать_сертификаты = S
End Function

@Shuret · 28.06.2012, 00:56 **[ТС]**

не получается наслаждаться. убрала один диаметр - ошибка #ИМЯ!

@Alex77755 · 28.06.2012, 01:01

Оставил только один диаметр, оставил два - всё нормально

@Shuret · 28.06.2012, 01:04 **[ТС]**

странно. закрыла - открыла - работает. но, если ввожу 32х3,2 диаметр в футляр_2 выскакивает вот что.

@Shuret · 28.06.2012, 01:15 **[ТС]**

четвертая строка. ее в этом случае быть не должно( т.к. 32 уже есть выше. и как-то не корректна она сама по себе вышла(

Добавлено через 7 минут
и если ввожу диаметры вот в таком порядке: 32, 15, 25, 50, 50, 32 то выходит, что во второй строке повторяется 50, а в четвертой - вышеописанная ошибка.

Добавлено через 1 минуту
вот скрин

@Alex77755 · 28.06.2012, 01:15

на повторяемость проверки не делал. надо доработать защиту от...
С ошибко пока не пойму. Возможно дело в дате

@Shuret · 28.06.2012, 01:17 **[ТС]**

вот скрин

@Shuret · 28.06.2012, 01:25 **[ТС]**

с ошибкой разобралась. оказывается, нельзя менять функции в ячейках сертификата. а нужно будет. потому что у меня там сейчас забиты не только сертификаты, но и остальные документы. а для работы этой функции нужны только сертификаты (они числятся как паспорта в каталоге материалов). если поставить диаметр 159х4,0 вылезает много лишнего. и еще, функции в ячейках (сертификаты, производитель) почему-то стали с абсолютнымы ссылками. как же я их потом растяну?

@Alex77755 · 28.06.2012, 01:29

В твои функции я не вмешивался. В моей делать абсолютные не надо
Что бы не повторялись диаметры:

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
Function Группировать_сертификаты(Строка_данных As Range, _
Optional Наименование As String, Optional Знак As String) As String
Dim C
Dim S As String
Dim M()
Dim Stroka As String
Dim oDict: Set oDict = CreateObject("Scripting.Dictionary")  ' Создаем словарь
Dim oD: Set oD = CreateObject("Scripting.Dictionary")  ' Создаем словарь
For C = 2 To Строка_данных.Columns.Count Step 3
 
    If Строка_данных.Cells(1, C - 1).Value <> Empty Then
        Stroka = Left(Строка_данных.Cells(1, C).Value, Len(Строка_данных.Cells(1, C).Value) - 17) & Наименование & " " & Знак
            If oDict.Exists(Строка_данных.Cells(1, C).Value) Then
                If Not oD.Exists(Строка_данных.Cells(1, C - 1).Value) Then
                    oDict.Item(Строка_данных.Cells(1, C).Value) = oDict.Item(Строка_данных.Cells(1, C).Value) & "; " & Знак & Строка_данных.Cells(1, C - 1).Value
                End If
            Else
                oDict.Add Строка_данных.Cells(1, C).Value, Stroka & Строка_данных.Cells(1, C - 1).Value
                oD.Add Строка_данных.Cells(1, C - 1).Value, 1
            End If
    End If
Next C
M = oDict.keys
For C = 0 To oDict.Count - 1
 S = S & oDict.Item(M(C)) & " " & Right(M(C), 17) & vbCrLf
Next C
Группировать_сертификаты = S
End Function

@Shuret · 28.06.2012, 01:33 **[ТС]**

чувствую себя привередой, но выскакивает ошибка ЗНАЧ

@Alex77755 · 28.06.2012, 01:34

если поставить диаметр 159х4,0 вылезает много лишнего

Ну не буду же я исправлять твои формулы и значения!!
Сравни что выведено у тебя. У меня берётся из твоих значений 1 к 1

@Shuret · 28.06.2012, 01:35 **[ТС]**

нет же, совсем не прошу исправлять мои. просто, я исправила и появилась та ошибка с четвертой строкой.

@Alex77755 · 28.06.2012, 01:41

Где-то стоит лишний пробел в твоих данных.
У тебя строка сцеплена. Для вставки диаметров до даты я отделяю 17 символов от конца.
В четвёртой строке оторвана одна цифра. Значит где-то не такой формат как везде.
Попробуй в 10 строке поменять 17 на 16. У меня ошибки нет

@Shuret · 28.06.2012, 01:43 **[ТС]**

спасибо

@Alex77755 · 28.06.2012, 01:44

Ну всё? получилось?

@Shuret · 28.06.2012, 01:47 **[ТС]**

странно. если в футляр_2 ввожу 76х3,5, то функция работает, если 32х3,2 - ошибка ЗНАЧ! буду искать у себя пробелы. но повтор 50 не убрался(

@Shuret · 28.06.2012, 01:51 **[ТС]**

ввожу 20 - работает, но сертификат с 20 повторяется. 25, 15 в футляр_2 - ошибка ЗНАЧ

@Shuret · 28.06.2012, 01:56 **[ТС]**

с повтором 20 и ошибкой знач решился вопрос)))) нашла ошибку!!! но 50 все равно повторяются

Добавлено через 1 минуту
ошибка знач появляется, если я свою функцию меняю.

@Alex77755 · 28.06.2012, 01:56

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
Function Группировать_сертификаты(Строка_данных As Range, _
Optional Наименование As String, Optional Знак As String) As String
Dim C
Dim S As String
Dim M()
Dim Stroka As String
Dim oDict: Set oDict = CreateObject("Scripting.Dictionary")  ' Создаем словарь
Dim oD: Set oD = CreateObject("Scripting.Dictionary")  ' Создаем словарь
For C = 2 To Строка_данных.Columns.Count Step 3
   If Строка_данных.Cells(1, C - 1).Value <> Empty Then
        Stroka = Left(Строка_данных.Cells(1, C).Value, Len(Строка_данных.Cells(1, C).Value) - 16) & Наименование & " " & Знак
         If Not oD.Exists(Строка_данных.Cells(1, C - 1).Value) Then
           oD.Add Строка_данных.Cells(1, C - 1).Value, 1
            If oDict.Exists(Строка_данных.Cells(1, C).Value) Then
                oDict.Item(Строка_данных.Cells(1, C).Value) = oDict.Item(Строка_данных.Cells(1, C).Value) & "; " & Знак & Строка_данных.Cells(1, C - 1).Value
            Else
                oDict.Add Строка_данных.Cells(1, C).Value, Stroka & Строка_данных.Cells(1, C - 1).Value
           End If
         End If
      End If
    Next C
M = oDict.keys
For C = 0 To oDict.Count - 1
 S = S & oDict.Item(M(C)) & " " & Right(M(C), 17) & vbCrLf
Next C
Группировать_сертификаты = S
End Function

@Shuret · 28.06.2012, 01:59 **[ТС]**

спасибо!!! повторы ушли)))

Добавлено через 1 минуту
я правильно поняла, что шаг3 обязателен?

Новые блоги и статьи Все статьи Все блоги /
Генератор паролей (вариант №3) Maks 30.10.2026 Финальная версия генератора паролей 1С. Доработка решения в этот раз коснулась только визуальной части, а именно, добавлен реквизит ДопПараметры (тип Булево), который скрывает/ отображает реквизиты:. . .	Магическое мышление и магия, современная наука не отличима от магии (говорит ИИ Джемени) zorxor 30.10.2026 Джемени, расскажи, пожалуйста, что такое магическое мышление, что такое магия, почему современная наука чем-то напоминает магию? Фраза «Любая достаточно развитая технология неотличима от магии». . .	За какое время ИИ может подобрать пароль по хешу (рассказывает Джемени ИИ) zorxor 30.10.2026 Расскажи, Джемени, если известен хэш МД5, например, за сколько ИИ сможет подобрать соответствующий пароль? Искусственный интеллект (ИИ) может подобрать простой или средний по сложности пароль по. . .	Кто убил Suno? Почему наше солнышко погасло? (диалог с ИИ Джемени) zorxor 30.10.2026 Как убивали Suno. Хронология. «Убийство» музыкальной нейросети Suno — это затяжной процесс, в котором технологический хайп стартапа разбился о жесткую реальность судебных исков от гигантов. . .
Генератор паролей (вариант №2) Maks 30.10.2026 Обновленная версия ранее созданной обработки. Добавлены следующие реквизиты типа Булево: - Буквы; - Цифры; - Символы. Изменена логика команды "Сгенерировать" и процедуры "ПриОткрытии":. . .	Генератор паролей (вариант №1) Maks 29.10.2026 Реализация из решения ниже выполнена исключительно по моей инициативе, дабы облегчить себе работу в создании паролей для администрируемых мною сервисов и пользователей. Самым главным критерием для. . .	Установка ChatGPT (Codex) на Windows без использования Microsoft Store Fabien159 28.10.2026 Здравствуйте всем читающим! Опишу процесс установки ChatGPT (Codex) на Windows, если по каким-то причинам у вас не получается устанавить его через Microsoft Store. И так: 1. Скачиваем с. . .	Программное добавление префикса в нумерацию документов Maks 27.10.2026 Реализация из решения ниже выполнена в самописной конфигурации на БСП (помощь начинающему коллеге). Задача: Программно добавить префикс в нумерацию документов. Решение: В модуле объекта. . .

@Shuret 0 / 0 / 0 Регистрация: 27.06.2012 Сообщений: 57
	28.06.2012, 00:56 [ТС]
	не получается наслаждаться. убрала один диаметр - ошибка #ИМЯ! 0

@Alex77755 11525 / 3812 / 683 Регистрация: 13.02.2009 Сообщений: 11,229
	28.06.2012, 01:01
	Оставил только один диаметр, оставил два - всё нормально Миниатюры 0

@Shuret 0 / 0 / 0 Регистрация: 27.06.2012 Сообщений: 57
	28.06.2012, 01:04 [ТС]
	странно. закрыла - открыла - работает. но, если ввожу 32х3,2 диаметр в футляр_2 выскакивает вот что. Миниатюры 0

@Shuret 0 / 0 / 0 Регистрация: 27.06.2012 Сообщений: 57
	28.06.2012, 01:15 [ТС]
	четвертая строка. ее в этом случае быть не должно( т.к. 32 уже есть выше. и как-то не корректна она сама по себе вышла( Добавлено через 7 минут и если ввожу диаметры вот в таком порядке: 32, 15, 25, 50, 50, 32 то выходит, что во второй строке повторяется 50, а в четвертой - вышеописанная ошибка. Добавлено через 1 минуту вот скрин 0

@Alex77755 11525 / 3812 / 683 Регистрация: 13.02.2009 Сообщений: 11,229
	28.06.2012, 01:15
	на повторяемость проверки не делал. надо доработать защиту от... С ошибко пока не пойму. Возможно дело в дате 0

@Shuret 0 / 0 / 0 Регистрация: 27.06.2012 Сообщений: 57
	28.06.2012, 01:17 [ТС]
	вот скрин Миниатюры 0

@Shuret 0 / 0 / 0 Регистрация: 27.06.2012 Сообщений: 57
	28.06.2012, 01:25 [ТС]
	с ошибкой разобралась. оказывается, нельзя менять функции в ячейках сертификата. а нужно будет. потому что у меня там сейчас забиты не только сертификаты, но и остальные документы. а для работы этой функции нужны только сертификаты (они числятся как паспорта в каталоге материалов). если поставить диаметр 159х4,0 вылезает много лишнего. и еще, функции в ячейках (сертификаты, производитель) почему-то стали с абсолютнымы ссылками. как же я их потом растяну? 0

@Shuret 0 / 0 / 0 Регистрация: 27.06.2012 Сообщений: 57
	28.06.2012, 01:33 [ТС]
	чувствую себя привередой, но выскакивает ошибка ЗНАЧ 0

@Shuret 0 / 0 / 0 Регистрация: 27.06.2012 Сообщений: 57
	28.06.2012, 01:35 [ТС]
	нет же, совсем не прошу исправлять мои. просто, я исправила и появилась та ошибка с четвертой строкой. 0

@Alex77755 11525 / 3812 / 683 Регистрация: 13.02.2009 Сообщений: 11,229
	28.06.2012, 01:41
	Где-то стоит лишний пробел в твоих данных. У тебя строка сцеплена. Для вставки диаметров до даты я отделяю 17 символов от конца. В четвёртой строке оторвана одна цифра. Значит где-то не такой формат как везде. Попробуй в 10 строке поменять 17 на 16. У меня ошибки нет 0

@Shuret 0 / 0 / 0 Регистрация: 27.06.2012 Сообщений: 57
	28.06.2012, 01:43 [ТС]
	спасибо 0

@Alex77755 11525 / 3812 / 683 Регистрация: 13.02.2009 Сообщений: 11,229
	28.06.2012, 01:44
	Ну всё? получилось? 0

@Shuret 0 / 0 / 0 Регистрация: 27.06.2012 Сообщений: 57
	28.06.2012, 01:47 [ТС]
	странно. если в футляр_2 ввожу 76х3,5, то функция работает, если 32х3,2 - ошибка ЗНАЧ! буду искать у себя пробелы. но повтор 50 не убрался( 0

@Shuret 0 / 0 / 0 Регистрация: 27.06.2012 Сообщений: 57
	28.06.2012, 01:51 [ТС]
	ввожу 20 - работает, но сертификат с 20 повторяется. 25, 15 в футляр_2 - ошибка ЗНАЧ Миниатюры 0

@Shuret 0 / 0 / 0 Регистрация: 27.06.2012 Сообщений: 57
	28.06.2012, 01:56 [ТС]
	с повтором 20 и ошибкой знач решился вопрос)))) нашла ошибку!!! но 50 все равно повторяются Добавлено через 1 минуту ошибка знач появляется, если я свою функцию меняю. 0

@Shuret 0 / 0 / 0 Регистрация: 27.06.2012 Сообщений: 57
	28.06.2012, 01:59 [ТС]
	спасибо!!! повторы ушли))) Добавлено через 1 минуту я правильно поняла, что шаг3 обязателен? 0