Страницы: 1
RSS
Создание таблицы из попарно уникальных данных
 
Добрый день!  
Пыталась найти подобную тему, но не нашла.  
Есть данные в двух стобцах  
Задача: составить таблицу 2хN, состоящие из уникальных значений этих столбцов.  
Пример в файле, без него объяснить постановку вопроса не могу.  
Использовать необходимо формулы, так как на работе excel 2003
 
"Использовать необходимо формулы, так как на работе excel 2003" - не вижу логической связи :)  
Но вижу, как это можно сделать макросом - на словаре (или коллекции) в словаре.  
Ну раз "необходимо формулы" - я пас...
 
{quote}{login=Hugo}{date=18.12.2012 12:26}{thema=}{post}"Использовать необходимо формулы, так как на работе excel 2003" - не вижу логической связи :)  
Но вижу, как это можно сделать макросом - на словаре (или коллекции) в словаре.  
Ну раз "необходимо формулы" - я пас...{/post}{/quote}  
Если можете предложить макрос, то буду рада. Просто я пока не научилась с ними работать - будет повод научиться))  
Просто пока пользуюсь только формулами, так как считаю это универсальным способом
 
Я думаю, формулами это трудно сделать. А если данных много - то и тяжело :(  
Но я в формулах не специалист...  
Макросом тоже не десяток строк, и код будет не для начинающих.  
Чуть позже посмотрю, что можно сделать.
 
А нельзя сделать например кво по строчкам, а страны по столбцам, ну что вроде этого:  
    Бельгия Франция Россия и т.д.  
01010  
01030  
10020  
10030  
11010  
и т.д.
 
<<- в данных ячейках будут дальнейшие вычисления>>  
 
Значит там, где есть страны формулу написать уже нельзя.  
Либо другая структура, либо макрос от Hugo.
"..Сладку ягоду рвали вместе, горьку ягоду я одна."
 
Можно сделать почти как нужно сводной, а потом чуть подправить :)
 
Макрос. Для сравнения с примером выгружаю в 16, 17 столбцы - это можно подправить как нужно.  
Заливки цветом нет - но можно добавить.  
 
 
Option Explicit  
 
Sub StraniKodi()    ' словарь в словаре  
   Dim a, cArr, i&, t$, Dic As Object  
   Dim el, lr&  
 
   a = Range("B3", Cells(Rows.Count, "A").End(xlUp)).Value  
   Set Dic = CreateObject("Scripting.Dictionary")  
   With Dic  
       .CompareMode = 1  
       For i = 1 To UBound(a)  
           t = a(i, 2)  
           If Not .exists(t) Then .Add t, CreateObject("Scripting.Dictionary")  
           .Item(t).Item(Format(a(i, 1), "00000")) = 0&  
       Next  
   End With  
 
   cArr = Dic.keys: SortArray cArr  
 
   lr = 3  
   For Each el In cArr  
       Cells(lr, 17) = el: lr = lr + 1  
       a = Dic.Item(el).keys: SortArray a  
       With Cells(lr, 16).Resize(UBound(a) + 1, 1)  
           .NumberFormat = "00000"  
           .Value = Application.Transpose(a)  
       End With  
       lr = lr + UBound(a) + 1  
   Next  
 
End Sub  
 
 
Private Sub SortArray(ByRef a As Variant)  
   Dim i As Long, j As Long  
   Dim t As Variant  
 
   'standard bubble sort loops  
   For i = LBound(a) To UBound(a) - 1  
       For j = i + 1 To UBound(a)  
           If a(i) > a(j) Then    'change to < for descending order  
               t = a(i)  
               a(i) = a(j)  
               a(j) = t  
           End If  
       Next j  
   Next i  
End Sub
 
Hugo, спасибо большое! Как же всё таки VBA упрощает жизнь, но пока нет времени для изучения(  
Ещё 1 вопросик:  
Не совсем поняла, как изменить код, если список стран находится в столбце N, а коды в M
 
Исходные данные берутся в массив тут:  
a = Range("B3", Cells(Rows.Count, "A").End(xlUp)).Value  
Т.е. от B3 до последней снизу в столбце A.  
Соответственно меняйте буквы.  
Но в таком варианте не должно быть лишних данных ниже кодов.
Страницы: 1
Наверх