Страницы: 1
RSS
Работа с массивами данных, Фильтр и запись данных
 
Здравствуйте, подскажите, пожалуйста, есть массив данных, состоящий из двух столбцов. Значению первого столбца может соответсвовать несколько значений второго. Необходимо вывести значения, где в первом столбце находятся имена без повторений, а во втором - значения, которые соответствуют имени (Например, Аня 1, 3; Миша 2, 45 и тд).
 
Цитата
Анна Солнцева написал:
Работа с массивами данных
что тут скажешь? основное предназначение компьютера - это хранение и обработка файлов, т.е. работа с массивами данных
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Код
C2    =B2&","&ЕСЛИОШИБКА(ВПР(A2;A3:$C$1048576;3;0);"")
D2    =(СЧЁТЕСЛИМН($A$1:A2;A2)=1)+D1
E2    =ЕСЛИОШИБКА(ИНДЕКС(A:A;ПОИСКПОЗ(СТРОКА(E1);D:D;0));"")
F2    =ЕСЛИОШИБКА(ПСТР(ВПР(E2;A:C;3;0);1;ДЛСТР(ВПР(E2;A:C;3;0))-1);"")
и протянуть вниз.
 
Анна Солнцева, здравствуйте
Файл-пример
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
Анна Солнцева,  Работа с массивом данных - это очём? Разве из такого названия можно понять задачу?
Предложите новое - модераторы поменяют.
 
artemkau88, Огонь!, но:

1. 10 000 строк считает около сорока секунд.
2. Вы не учли, что столбцы имеют заголовок.

Вот мой вариант:

Прошу тапками не кидаться, я только учусь :-)

Код
Option Explicit

Sub Test()
  Dim n&, i&, j&, tmp As String, keys As String
   
  n = Cells(Rows.Count, 1).End(xlUp).Row
  
  Range("D2:E" & n).ClearContents
  Application.ScreenUpdating = False
  
  Range("XX2:XY" & 3 * n).ClearContents
  Range("XX1:XY" & n) = Range("A1:B" & n).Value
  ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
  ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("XX2:XX" & n) _
      , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
  With ActiveWorkbook.Worksheets("Sheet1").Sort
    .SetRange Range("XX1:XY" & n)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
  End With
  
  j = 1
  For i = 2 To n
    j = j + 1
    tmp = Cells(i, 648)
    keys = ""
    While tmp = Cells(i, 648)
      keys = keys & Cells(i, 649) & ", "
      i = i + 1
    Wend
    i = i - 1
    Cells(j, 4) = tmp
    Cells(j, 5) = Left(keys, Len(keys) - 2)
  Next i
  Range("XX1:XY" & n).ClearContents
  Cells(1, 4) = "Name"
  Cells(1, 5) = "Keys"
  Cells(2, 4).Select
  Application.ScreenUpdating = True
End Sub

Нас никому не сбить с пути, нам все равно куда идти.
Страницы: 1
Наверх