Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Транспонировать данные в одну ячейку - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Транспонировать данные в одну ячейку (Формулы/Formulas)
Транспонировать данные в одну ячейку
l-lisa Дата: Среда, 28.11.2018, 17:30 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 189
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Здравствуйте, есть ли возможность формулой перенести данные из одного столбца в ячейку через запятую, учитывая ID: то есть если ID повторяется то текстовые данные из рядом стоящего столбца объединять через запятую в ячейку, как показано в приложенном примере, ну или транспонировать в строку в разные ячейки?
К сообщению приложен файл: 6240134.xlsx(8.6 Kb)
 
Ответить
СообщениеЗдравствуйте, есть ли возможность формулой перенести данные из одного столбца в ячейку через запятую, учитывая ID: то есть если ID повторяется то текстовые данные из рядом стоящего столбца объединять через запятую в ячейку, как показано в приложенном примере, ну или транспонировать в строку в разные ячейки?

Автор - l-lisa
Дата добавления - 28.11.2018 в 17:30
l-lisa Дата: Среда, 28.11.2018, 17:48 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 189
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
или такая задача только макросом разрешима?
 
Ответить
Сообщениеили такая задача только макросом разрешима?

Автор - l-lisa
Дата добавления - 28.11.2018 в 17:48
_Boroda_ Дата: Среда, 28.11.2018, 18:51 | Сообщение № 3
Группа: Модераторы
Ранг: Местный житель
Сообщений: 13660
Репутация: 5574 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Так нужно?
Код
=ЕСЛИ(A2=A3;B2&";"&C3;B2)

И Условным форматированием скрываем ненужный текст
К сообщению приложен файл: 6240134_1.xlsx(10.1 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеТак нужно?
Код
=ЕСЛИ(A2=A3;B2&";"&C3;B2)

И Условным форматированием скрываем ненужный текст

Автор - _Boroda_
Дата добавления - 28.11.2018 в 18:51
l-lisa Дата: Среда, 28.11.2018, 18:53 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 189
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
Да! классно, спасибо большое! hands
 
Ответить
СообщениеДа! классно, спасибо большое! hands

Автор - l-lisa
Дата добавления - 28.11.2018 в 18:53
boa Дата: Среда, 28.11.2018, 19:03 | Сообщение № 5
Группа: Проверенные
Ранг: Обитатель
Сообщений: 264
Репутация: 55 ±
Замечаний: 0% ±

2013, 365
l-lisa,
или макросом на новый лист
[vba]
Код
Option Explicit

Sub Dictionary_Coll()
'  Справочный материал: https://www.osp.ru/winitpro/2006/07/3643019/
                       'http://perfect-excel.ru/publ/excel/makrosy_i_programmy_vba/ischerpyvajushhee_opisanie_obekta_dictionary/7-1-0-101
    Dim MyArray(), Dic As Object, a As Range
    
''   для раннего связывания требуется подключение
''   Tools - References... "Microsoft Scripting Runtime"
'    Set Dic = New Dictionary
    
    Set Dic = CreateObject("Scripting.Dictionary")
    On Error Resume Next    'что бы не останавливалось на ошибке
    
    For Each a In ActiveSheet.Range("a2:a13")
        If Dic.Exists(CStr(a)) Then 'Проверить наличие ключа
            Dic.Item(CStr(a)) = Dic.Item(CStr(a)) & "," & a.Offset(, 1).Value
        Else
            Dic.Add CStr(a), a.Offset(, 1).Value                    'добавление
'                    [ключ], [значение]
        End If
    Next a
    
    MyArray = Application.Transpose(Array(Dic.Keys, Dic.Items))
    
    With Worksheets.Add 'выводим на лист
        .Range(.Cells(1, 1), .Cells(UBound(MyArray, 1), UBound(MyArray, 2))) = MyArray
    End With
End Sub
[/vba]


 
Ответить
Сообщениеl-lisa,
или макросом на новый лист
[vba]
Код
Option Explicit

Sub Dictionary_Coll()
'  Справочный материал: https://www.osp.ru/winitpro/2006/07/3643019/
                       'http://perfect-excel.ru/publ/excel/makrosy_i_programmy_vba/ischerpyvajushhee_opisanie_obekta_dictionary/7-1-0-101
    Dim MyArray(), Dic As Object, a As Range
    
''   для раннего связывания требуется подключение
''   Tools - References... "Microsoft Scripting Runtime"
'    Set Dic = New Dictionary
    
    Set Dic = CreateObject("Scripting.Dictionary")
    On Error Resume Next    'что бы не останавливалось на ошибке
    
    For Each a In ActiveSheet.Range("a2:a13")
        If Dic.Exists(CStr(a)) Then 'Проверить наличие ключа
            Dic.Item(CStr(a)) = Dic.Item(CStr(a)) & "," & a.Offset(, 1).Value
        Else
            Dic.Add CStr(a), a.Offset(, 1).Value                    'добавление
'                    [ключ], [значение]
        End If
    Next a
    
    MyArray = Application.Transpose(Array(Dic.Keys, Dic.Items))
    
    With Worksheets.Add 'выводим на лист
        .Range(.Cells(1, 1), .Cells(UBound(MyArray, 1), UBound(MyArray, 2))) = MyArray
    End With
End Sub
[/vba]

Автор - boa
Дата добавления - 28.11.2018 в 19:03
l-lisa Дата: Среда, 28.11.2018, 21:07 | Сообщение № 6
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 189
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
boa, вообще самое то) hands
 
Ответить
Сообщениеboa, вообще самое то) hands

Автор - l-lisa
Дата добавления - 28.11.2018 в 21:07
_Boroda_ Дата: Четверг, 29.11.2018, 11:12 | Сообщение № 7
Группа: Модераторы
Ранг: Местный житель
Сообщений: 13660
Репутация: 5574 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
А я бы так написал
[vba]
Код
Sub tt()
    c_ = 1
    r0_ = 1
    n_ = Cells(Rows.Count, c_).End(3).Row - r0_ + 1
    ar = Cells(r0_, c_).Resize(n_, 2)
    Set slov = CreateObject("Scripting.Dictionary")
    With slov
        For i = 1 To n_
            If ar(i, 2) <> "" And ar(i, 2) <> "null" Then
                .Item(ar(i, 1)) = .Item(ar(i, 1)) & IIf(.exists(ar(i, 1)), ",", "") & ar(i, 2)
            End If
        Next i
        Sheets.Add
        Cells(1).Resize(.Count) = Application.Transpose(.Keys)
        Cells(2).Resize(.Count) = Application.Transpose(.items)
    End With
End Sub
[/vba]
Основные отличия - поиск последней заполненной ячейки и отсутствие работы с ячейками на листе
К сообщению приложен файл: 6240134_2.xlsm(16.7 Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеА я бы так написал
[vba]
Код
Sub tt()
    c_ = 1
    r0_ = 1
    n_ = Cells(Rows.Count, c_).End(3).Row - r0_ + 1
    ar = Cells(r0_, c_).Resize(n_, 2)
    Set slov = CreateObject("Scripting.Dictionary")
    With slov
        For i = 1 To n_
            If ar(i, 2) <> "" And ar(i, 2) <> "null" Then
                .Item(ar(i, 1)) = .Item(ar(i, 1)) & IIf(.exists(ar(i, 1)), ",", "") & ar(i, 2)
            End If
        Next i
        Sheets.Add
        Cells(1).Resize(.Count) = Application.Transpose(.Keys)
        Cells(2).Resize(.Count) = Application.Transpose(.items)
    End With
End Sub
[/vba]
Основные отличия - поиск последней заполненной ячейки и отсутствие работы с ячейками на листе

Автор - _Boroda_
Дата добавления - 29.11.2018 в 11:12
l-lisa Дата: Четверг, 29.11.2018, 11:52 | Сообщение № 8
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 189
Репутация: 1 ±
Замечаний: 0% ±

Excel 2010
_Boroda_, спасибо) hands
 
Ответить
Сообщение_Boroda_, спасибо) hands

Автор - l-lisa
Дата добавления - 29.11.2018 в 11:52
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Транспонировать данные в одну ячейку (Формулы/Formulas)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2018 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!