Страницы: 1
RSS
Преобразование структуры массива из строк в столбцы, Нужно отобразить данные вместо строк в столбцах
 
Добрый день,

Есть массив с данными, его нужно преобразовать таким образом, чтобы артикулы вариантов выводились не по отдельным строкам, а в одну строку (см. пример). Можно и в одну ячейку (через запятую).

Заранее благодарю за помощь.
 
В поиск - "Преобразование структуры массива из строк в столбцы".
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
Код
'в одной ячейке
Sub test()
    Dim arr(), dic As Object, i&, ikey
    Set dic = CreateObject("Scripting.Dictionary")
    With Лист1
        arr = .Range(.[b2], .[a2].End(xlDown)).Value
    End With
    For i = 1 To UBound(arr)
        dic.Item(CStr(arr(i, 1))) = dic.Item(CStr(arr(i, 1))) & arr(i, 2) & ","
    Next i
    Worksheets.Add
    [a2].Resize(dic.Count, 2) = Application.Transpose(Array(dic.keys, dic.items))
End Sub

'разнесено по разным ячейкам
Sub test1()
    Dim arr(), dic As Object, i&, ikey
    Set dic = CreateObject("Scripting.Dictionary")
    With Лист1
        arr = .Range(.[b2], .[a2].End(xlDown)).Value
    End With
    For i = 1 To UBound(arr)
        dic.Item(CStr(arr(i, 1))) = dic.Item(CStr(arr(i, 1))) & arr(i, 2) & "|"
    Next i
    Worksheets.Add: i = 2
    For Each ikey In dic.keys
        Cells(i, 1) = ikey
        Cells(i, 2).Resize(, UBound(Split(dic.Item(ikey), "|"))) = Split(dic.Item(ikey), "|")
        i = i + 1
    Next ikey
End Sub
Изменено: Nordheim - 17.04.2018 14:32:20
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, Спасибо огромное!  :D  
 
Формулами для Excel2010+.
 
Nordheim, еще вопрос: как сделать так, чтобы формат выводимых ячеек был текстовым?
А то нули "съедаются" в начале, а они нужны...
 
Не вижу в файле примере нулей. Поэтому нет возможности протестировать
возможно что так.
Скрытый текст
"Все гениальное просто, а все простое гениально!!!"
 
Nordheim, Спасибо!)
 
Почему-то перестал работать этот макрос...
Выдает ошибку  
Изменено: vikttur - 07.09.2021 22:17:45
 
Скачайте ваш файл из сообщения номер 1 и запустите ваш макрос - если всё работает, значит дело не в макросе, а дело в вашей таблице на листе.
Возможно данные (числа) начинаются не со второй строки, и не в столбце А. В макросе данные берутся с ячейки А2 и ниже
А вот так макрос работает? Лист должен иметь название "массив"
Код
Sub Транспонировать_по_артикулу()
    Dim arr(), dic As Object, i&, ikey
    Set dic = CreateObject("Scripting.Dictionary")
    With Worksheets("массив")
        arr = .Range(.[b2], .[a2].End(xlDown)).Value
    End With
    For i = 1 To UBound(arr)
        dic.Item(CStr(arr(i, 1))) = dic.Item(CStr(arr(i, 1))) & arr(i, 2) & "|"
    Next i
    Worksheets.Add after:=Sheets(Sheets.Count)
    i = 2
    Rows(i & ":" & i + dic.Count).NumberFormat = "@"
    For Each ikey In dic.keys
        Cells(i, 1) = ikey
        Cells(i, 2).Resize(, UBound(Split(dic.Item(ikey), "|"))) = Split(dic.Item(ikey), "|")
        i = i + 1
    Next ikey
End Sub
 
Проверю чуть позже, спасибо заранее
Страницы: 1
Наверх