Макрос сложного поиска

@soulthiefer · Регистрация: 29.10.2009

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

всем доброго дня ! помогите пожалуйста организовать поиск в эксель посредством макроса !
выкладываю файл в котором сделал все что мог .. в принципе все кроме поиска о котором прошу (
на первой вкладке : вводится пара фамилий людей который знают друг друга... в текстбоксах вводится если фамилии нет еще в списке в сомбобоксе выбирается из списка если существует фамилия ! Кнопка ЗАПИСАТЬ добавляет фамилии из полей в соответствующие колонки ( текстбоксы имеют приоритет перед комбо)
на второй вкладке : как раз и должен быть нужный мне поиск ( поиск ищет цепочку людей через которых я хочу познакомиться с человеком которого указал в комбобоксе на второй вкладке, ТОЕСТЬ найти возможную комбинацию/комбинации по принципу: "Мне нужно познакомиться с Петровым. Посмотрим, кто из моих знакомых, или знакомых моих знакомых знает этого человека ( под кнопкой ПОИСК ВАРИАНТОВ расположен лэйбл3 в нем и должны выводится варианты ! пример запроса и ответов на него на самом листе справа от столбиков фамилий !
ПОМОГИТЕ пожалуйста с этим самым поиском!!! я в полном тупике (

@Toxa33rus · 29.10.2009, 14:50

Все возможные варианты надо или самый короткий?
Интересная задачка.

@soulthiefer · 29.10.2009, 15:07 **[ТС]**

нужны все возможные варианты
оч интересная ))
я в полном тупике и тупняке 4 день((
если есть возможность и знания то оч прошу помощи

@Toxa33rus · 30.10.2009, 18:19

Сообщение от soulthiefer

нужны все возможные варианты

Плохо.
Вдруг получится так что: я-иванов-петров-иванов-петров-....-сидоров
Вот и будет программа выдавать бесконечно вариантов. Придется дополнительно придумывать что-то.
Сейчас (только еще) начну думать...

@Toxa33rus · 31.10.2009, 10:03

А если Я знаю Петрова, то и Петров знает меня?
Если да, то задача усложняется (надо искать как связь слева направо так и справа налево), а если нет то у вас ошибка в решении:
сидоров-жуков-петров-я
т.е. я знаю петрова, но петров НЕ знает жукова! Это наоборот жуков знает петрова.

Короче вот что получилось:

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
Dim arrMain()
 
Sub main()
GetMainArray
 
First = "я"
Last = "сидоров"
 
currAdress = Last & "-"
 
find currAdress, First
End Sub
 
Private Sub find(ByVal adress As String, ByVal findName As String)
  lastName = Split(Left(adress, Len(adress) - 1), "-")
  lastName = lastName(UBound(lastName)) 'чьих друзей ищем в данный момент
  
  For i = 0 To UBound(arrMain, 2)
    If arrMain(1, i) = lastName And arrMain(0, i) = findName Then 'нашли!
      Debug.Print adress & findName
    End If
    
    If arrMain(1, i) = lastName And InStr(adress, arrMain(0, i) & "-") = 0 Then 'если еще не было такой фамилии
      find adress & arrMain(0, i) & "-", findName
    End If
  Next i
End Sub
 
Private Sub GetMainArray()
  ReDim arrMain(0 To 1, 0)
  currRow = 1
  Do While Cells(currRow, 1).Value <> ""
    arrMain(0, UBound(arrMain, 2)) = Cells(currRow, 1).Value
    arrMain(1, UBound(arrMain, 2)) = Cells(currRow, 2).Value
    ReDim Preserve arrMain(0 To 1, UBound(arrMain, 2) + 1)
    currRow = currRow + 1
  Loop
  ReDim Preserve arrMain(0 To 1, UBound(arrMain, 2) - 1)
End Sub

@soulthiefer · 02.11.2009, 09:03 **[ТС]**

урааааааа !!!! сдвинулосьс мертвой точки !!!!!!
только в том то и дело что пара фамилий друг напротив друга обоюдно знает друг друга (( и нужны все варианты связи с конечным человеком !
в этом то вся и огромная сложность для меня (((
приведенный Вами пример : какой из макросов повесить на кнопку поиск ?!??! ни один из них не выполняется , все пишут ошибки (

@Toxa33rus · 02.11.2009, 11:13

Сообщение от soulthiefer

какой из макросов повесить на кнопку поиск ?

main()

Добавлено через 15 минут

Сообщение от soulthiefer

в том то и дело что пара фамилий друг напротив друга обоюдно знает друг друга

Проблему решил тупо продублировав еще раз массив но сделав фамилии наоборот:

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
Dim arrMain()
 
Sub main()
GetMainArray
 
First = "я" 'кто ищет
Last = "сидоров" 'кого ищет
 
currAdress = Last & "-"
 
find currAdress, First
End Sub
 
Private Sub find(ByVal adress As String, ByVal findName As String)
  lastName = Split(Left(adress, Len(adress) - 1), "-")
  lastName = lastName(UBound(lastName)) 'чьих друзей ищем в данный момент
  
  For i = 0 To UBound(arrMain, 2)
    If arrMain(1, i) = lastName And arrMain(0, i) = findName Then 'нашли!
      Debug.Print adress & findName
    End If
    
    If arrMain(0, i) <> findName And InStr(adress, arrMain(0, i) & "-") = 0 Then 'если еще не было такой фамилии
      If arrMain(1, i) = lastName Then
        find adress & arrMain(0, i) & "-", findName
      End If
    End If
  Next i
End Sub
 
Private Sub GetMainArray()
  ReDim arrMain(0 To 1, 0 To 1)
  currRow = 1
  Do While Cells(currRow, 1).Value <> ""
    arrMain(0, UBound(arrMain, 2) - 1) = Cells(currRow, 1).Value
    arrMain(1, UBound(arrMain, 2) - 1) = Cells(currRow, 2).Value
    
    arrMain(0, UBound(arrMain, 2)) = Cells(currRow, 2).Value
    arrMain(1, UBound(arrMain, 2)) = Cells(currRow, 1).Value
    
    ReDim Preserve arrMain(0 To 1, UBound(arrMain, 2) + 2)
    currRow = currRow + 1
  Loop
  ReDim Preserve arrMain(0 To 1, UBound(arrMain, 2) - 2)
End Sub

@soulthiefer · 02.11.2009, 11:47 **[ТС]**

пишет varieble nit defined (
вставил в свой файл ... нифига (( посмотрите плз !

@Toxa33rus · 02.11.2009, 16:27

Или Option Explicit в комменты или объявите все переменные (Dim First, Dim Last .....)

@Toxa33rus · 03.11.2009, 20:03

Вызывайте форму и в бой

Попробовал сам с собой познакомиться но как оказалось это не так-то просто)))

@soulthiefer · 05.11.2009, 11:01 **[ТС]**

оно работает !!!!!!!!! вы просто гений честное слово !
огромное вам человеческое спасибо за отзывчивость!!!!!!! за комменты в макросе отдельная благодарность !!!

Новые блоги и статьи Все статьи Все блоги /
SDL3 для Desktop (MinGW): Рисуем цветные прямоугольники с помощью рисовальщика SDL3 на Си и C++ 8Observer8 17.03.2026 Содержание блога Финальные проекты на Си и на C++: finish-rectangles-sdl3-c. zip finish-rectangles-sdl3-cpp. zip	Символические и жёсткие ссылки в Linux. algri14 15.03.2026 Существует два типа ссылок — символические и жёсткие. Ссылка в Linux — это запись в каталоге, которая может указывать либо на inode «файла-ИСТОЧНИКА», тогда это будет «жёсткая ссылка» (hard link),. . .	[Owen Logic] Поддержание уровня воды в резервуаре количеством включённых насосов: моделирование и выбор регулятора ФедосеевПавел 14.03.2026 Поддержание уровня воды в резервуаре количеством включённых насосов: моделирование и выбор регулятора ВВЕДЕНИЕ Выполняя задание на управление насосной группой заполнения резервуара,. . .	делаю науч статью по влиянию грибов на сукцессию anaschu 13.03.2026 прикрепляю статью
SDL3 для Desktop (MinGW): Создаём пустое окно с нуля для 2D-графики на SDL3, Си и C++ 8Observer8 10.03.2026 Содержание блога Финальные проекты на Си и на C++: hello-sdl3-c. zip hello-sdl3-cpp. zip Результат:	Установка CMake и MinGW 13.1 для сборки С и C++ приложений из консоли и из Qt Creator в EXE 8Observer8 10.03.2026 Содержание блога MinGW - это коллекция инструментов для сборки приложений в EXE. CMake - это система сборки приложений. Здесь описаны базовые шаги для старта программирования с помощью CMake и. . .	Как дизайн сайта влияет на конверсию: 7 решений, которые реально повышают заявки Neotwalker 08.03.2026 Многие до сих пор воспринимают дизайн сайта как “красивую оболочку”. На практике всё иначе: дизайн напрямую влияет на то, оставит человек заявку или уйдёт через несколько секунд. Даже если у вас. . .	Модульная разработка через nuget packages DevAlt 07.03.2026 Сложившийся в . Net-среде способ разработки чаще всего предполагает монорепозиторий в котором находятся все исходники. При создании нового решения, мы просто добавляем нужные проекты и имеем. . .

@Toxa33rus 3924 / 925 / 125 Регистрация: 16.04.2009 Сообщений: 1,975
	29.10.2009, 14:50
	Все возможные варианты надо или самый короткий? Интересная задачка. 1

@soulthiefer 0 / 0 / 0 Регистрация: 29.10.2009 Сообщений: 17
	29.10.2009, 15:07 [ТС]
	нужны все возможные варианты оч интересная )) я в полном тупике и тупняке 4 день(( если есть возможность и знания то оч прошу помощи 0

@soulthiefer 0 / 0 / 0 Регистрация: 29.10.2009 Сообщений: 17
	02.11.2009, 09:03 [ТС]
	урааааааа !!!! сдвинулосьс мертвой точки !!!!!! только в том то и дело что пара фамилий друг напротив друга обоюдно знает друг друга (( и нужны все варианты связи с конечным человеком ! в этом то вся и огромная сложность для меня ((( приведенный Вами пример : какой из макросов повесить на кнопку поиск ?!??! ни один из них не выполняется , все пишут ошибки ( 0

@Toxa33rus 3924 / 925 / 125 Регистрация: 16.04.2009 Сообщений: 1,975
	02.11.2009, 16:27
	Или Option Explicit в комменты или объявите все переменные (Dim First, Dim Last .....) 1

@soulthiefer 0 / 0 / 0 Регистрация: 29.10.2009 Сообщений: 17
	05.11.2009, 11:01 [ТС]
	оно работает !!!!!!!!! вы просто гений честное слово ! огромное вам человеческое спасибо за отзывчивость!!!!!!! за комменты в макросе отдельная благодарность !!! 0