Уважаемые эксперты, подскажите, пожалуйста, как сделать выборку по одинаковым ячейкам таблицы, если одной ячейке может соответствовать несколько разных ячеек в другом столбце. Привожу пример в прикрепленных файлах.
Уважаемые эксперты, подскажите, пожалуйста, как сделать выборку по одинаковым ячейкам таблицы, если одной ячейке может соответствовать несколько разных ячеек в другом столбце. Привожу пример в прикрепленных файлах.Osa
спасибо большое. Если не сложно, то подскажите какой будет макрос в обратную сторону. Мне надо наоборот, чтобы выборка была по именам. в моих приложенных файлах первый - это то, что есть, а второй - то что надо сделать.
спасибо большое. Если не сложно, то подскажите какой будет макрос в обратную сторону. Мне надо наоборот, чтобы выборка была по именам. в моих приложенных файлах первый - это то, что есть, а второй - то что надо сделать.Osa
Сообщение отредактировал Osa - Понедельник, 02.02.2015, 16:41
Sub qwe() With Application: .ScreenUpdating = 0: .EnableEvents = 0: .DisplayAlerts = 0 With ActiveWorkbook.Worksheets("Лист1").Sort With .SortFields .Clear .Add Intersect([A1].CurrentRegion, [E:E]), 0, 1, 0 .Add Intersect([A1].CurrentRegion, [F:F]), 0, 1, 0 .Add Intersect([A1].CurrentRegion, [D:D]), 0, 1, 0 End With .SetRange [A1].CurrentRegion .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Dim col As Range, rcnt&, rnum&: rnum = 2 With Intersect([A2].CurrentRegion, [E:G], ActiveSheet.UsedRange.Offset(1)) .Select Do On Error Resume Next Selection.ColumnDifferences(ActiveCell).Select rcnt = Selection.Row - rnum: rnum = Selection.Row If rcnt > 1 Then For Each col In .Rows(rnum).Offset(-rcnt - 1).Resize(rcnt).Columns col.Merge Next End If Loop Until Err.Number If Selection.Rows.Count > 1 Then For Each col In Selection.Columns col.Merge Next End If End With Intersect([A1].CurrentRegion, [D:D]).Cut Intersect([A1].CurrentRegion.EntireRow, [H:H]).Insert Shift:=xlToRight Intersect([A1].CurrentRegion, [D:G]).Cut Intersect([A1].CurrentRegion, [A:A]).Insert Shift:=xlToRight .ScreenUpdating = 1: .EnableEvents = 1: .DisplayAlerts = 1: End With End Sub
[/vba]
[vba]
Код
Sub qwe() With Application: .ScreenUpdating = 0: .EnableEvents = 0: .DisplayAlerts = 0 With ActiveWorkbook.Worksheets("Лист1").Sort With .SortFields .Clear .Add Intersect([A1].CurrentRegion, [E:E]), 0, 1, 0 .Add Intersect([A1].CurrentRegion, [F:F]), 0, 1, 0 .Add Intersect([A1].CurrentRegion, [D:D]), 0, 1, 0 End With .SetRange [A1].CurrentRegion .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Dim col As Range, rcnt&, rnum&: rnum = 2 With Intersect([A2].CurrentRegion, [E:G], ActiveSheet.UsedRange.Offset(1)) .Select Do On Error Resume Next Selection.ColumnDifferences(ActiveCell).Select rcnt = Selection.Row - rnum: rnum = Selection.Row If rcnt > 1 Then For Each col In .Rows(rnum).Offset(-rcnt - 1).Resize(rcnt).Columns col.Merge Next End If Loop Until Err.Number If Selection.Rows.Count > 1 Then For Each col In Selection.Columns col.Merge Next End If End With Intersect([A1].CurrentRegion, [D:D]).Cut Intersect([A1].CurrentRegion.EntireRow, [H:H]).Insert Shift:=xlToRight Intersect([A1].CurrentRegion, [D:G]).Cut Intersect([A1].CurrentRegion, [A:A]).Insert Shift:=xlToRight .ScreenUpdating = 1: .EnableEvents = 1: .DisplayAlerts = 1: End With End Sub
Становитесь в таблицу -- вкладка Вставка -- Сводная таблица -- проверяете выделившийся диапазон -- ставите переключатель на новый лист или на существующий -- ОК. Получаете заготовку для сводной и список полей справа. Затем начинаете выбирать нужные поля, можно перетаскивать мышкой. На вкладке Конструктор выберите макет В виде таблицы. Подробнее можно прочитать в справке или здесь http://www.planetaexcel.ru/techniques/8/130/
Становитесь в таблицу -- вкладка Вставка -- Сводная таблица -- проверяете выделившийся диапазон -- ставите переключатель на новый лист или на существующий -- ОК. Получаете заготовку для сводной и список полей справа. Затем начинаете выбирать нужные поля, можно перетаскивать мышкой. На вкладке Конструктор выберите макет В виде таблицы. Подробнее можно прочитать в справке или здесь http://www.planetaexcel.ru/techniques/8/130/Pelena
"Черт возьми, Холмс! Но как??!!" Ю-money 41001765434816
Pelena, еще вопросик. у меня все получается, только не могу понять почему в каждой ячейке перед значениями стои знак "-" в голубом прямоугольнике. Может подскажете?
Pelena, еще вопросик. у меня все получается, только не могу понять почему в каждой ячейке перед значениями стои знак "-" в голубом прямоугольнике. Может подскажете?Osa
Например, добавить столбец в исходные данные и текстом прописать цвет этих ячеек: зеленый, красный, синий. Или какие-то условные коды: 1, 2, 3. Чтобы прописать один цвет сразу в несколько ячеек можно сначала отсортировать данные по цвету - в последних версиях Excel такая возможность имеется.
Или написать на VBA крохотную функцию (UDF), которая сразу будет выводить код цвета - там, RGB или ColorIndex.
Например, добавить столбец в исходные данные и текстом прописать цвет этих ячеек: зеленый, красный, синий. Или какие-то условные коды: 1, 2, 3. Чтобы прописать один цвет сразу в несколько ячеек можно сначала отсортировать данные по цвету - в последних версиях Excel такая возможность имеется.
Или написать на VBA крохотную функцию (UDF), которая сразу будет выводить код цвета - там, RGB или ColorIndex.Gustav