Создание базы данных один-ко-многим в Excel

[Lame]

Приветствую.
Есть некоторая задачка которую не могу решить с помощью массивов (использование VBA обязательно). Нужно получить некоторое подобие реляционной базы даннных MS Access одни -ко-многим.


Дано:

Нумерованный список от 1 до 15 (в списке только уникальные значения). Каждому значению соответствует уникальное слово, пусть это будет наименование компании. Соответственно, есть 15 различных наименований компаний

Дан второй список. В списке два столбца. Первый содержит любое количество строк с числами от 1 до 15 в каждой, каждому значению первого столбца соответствует некоторое значение второго столбца, допустим это имя и фамилия. Т.е. во втором списке все значения могут быть с повторениями.

Задача.
Необходимо построить список, в котором наименованиям компаний соответствует имена и фамилии.

Или, более практически- если предположить, что имя и фамилия из второго списка есть реквизиты покупателей, то необходимо составить список покупателей каждой компании.

Задачу надо решить с помощью маcсивов так, чтобы результат сохранялся в массиве в виде списка компании и соответствующих покупателей.

[Avsha]

Как хорошо задачу поставили
Еще бы файл с исходными данными приложили ...

[Lame]

Пожалуйста ))

[Avsha]

ну вот так в первом приближении...

Код: Выделить всё

Private Sub CommandButton1_Click()

Dim i As Long
Dim Arr_r1(15, 100) As String

Dim r1 As Range
Dim r2 As Range
    
    Set r1 = Application.Range("Name_r1")
    Set r2 = Application.Range("Name_r2")
    
 
' формирование массивов
    For i = 1 To r2.Rows.Count
        If r2.Cells(i, 1).Value = "" Then Exit For
        
        Arr_r1(r2.Cells(i, 1).Value, 0) = Str(Val(Arr_r1(r2.Cells(i, 1).Value, 0)) + 1)
        Arr_r1(r2.Cells(i, 1).Value, Val(Arr_r1(r2.Cells(i, 1).Value, 0))) = r2.Cells(i, 2).Value
        
    Next i

' вывод массивов
Dim r3 As Range
Set r3 = Range("F2")
r3.Resize(15, 100).ClearContents
   
    For j = 1 To 15
            r3.Cells(1, j).Value = r1.Cells(j, 1).Value
            r3.Cells(2, j).Value = r1.Cells(j, 2).Value
        For i = 1 To 100
            If Arr_r1(j, i) = "" Then Exit For
            r3.Cells(i + 2, j).Value = Arr_r1(j, i)
        Next i
    Next j

End Sub

[Aent]

Lame, не совсем ясно в каком виде вы хотите получить результат ?
Что значить "сохранялся в массиве"
Cкажем устроит ли простой автофильтр для второго листа (при условии что будет
отображаться название компании) ?
Лучше всего руками изобразите лист с желаемым результатом

[Teslenko_EA]

Здравствуйте Lame.
Не совсем понятно зачем делать из велосипеда подобие автомобиля если уже давно изобретен атомобиль ?

[Lame]

Str(Val(Arr_r1(r2.Cells(i, 1).Value, 0)) + 1)


Спасибо. Вы мне очень помогли. Скажите, а что обозначает эта строчка?

[Lame]

Здравствуйте Teslenko_EA
Вы правы в целом. Есть просто некоторые исключения. Например я пишу код который открывает указанный ваше лист выбирает данные и закрывает. ))).

[Teslenko_EA]

Lame, не проще ли табличние данные хранить не в "приспособленных" таблицах Excel, а в таблицах базы данных, и создавать свой "список" одной строкой запроса ?)))
Евгений

[Avsha]

Str(Val(Arr_r1(r2.Cells(i, 1).Value, 0)) + 1)


Спасибо. Вы мне очень помогли. Скажите, а что обозначает эта строчка?

это в нулевом элементе массива хранится счетчик для каждой фирмы
поствавьте STOP после формирования массива, вытащите окно Watches в редакторе VBA, перетащите в это окно массив Arr_r1 и просмотрите его содержимое.
Клавишей F8 проверяете программу пошагово и смотрите значения массива и других переменных.


Да, фамилии в кампаниях в предыдущем варианте повторяются. Чтобы это избежать необходимо отсортировать массив с фамилиями и делать сравнение с предшествующим элементом.