Страницы: 1 2 След.
RSS
Макрос для транспонирования двумерного массива данных
 
Добрый день.
Может кто нибудь поделиться макросом для транспонирования двумерного массива данных в один столбец, в одну строку.
Пример прилагаю.
Пока не нужно в работе, но может быть есть и макрос который транспонирует одномерный вертикальный или горизонтальный массив в двумерный  с предварительным указанием количества столбцов ?
Всем спасибо за помощь.
 
Эт не совсем транспонирование на данном утрированом примере (структура данных думаю в реальности не такая и начнутся вопросы), можно использовать просто функцию НАИМЕНЬШИЙ
Лень двигатель прогресса, доказано!!!
 
Разумеется это только пример. Размер и содержание массива (текстовые или числовые значения) могут быть разные.
Если это можно сделать не макросом, а штатными инструментами excel - тоже неплохо. Только дайте наводку )
Изменено: che - 11.03.2015 09:49:53
 
наводки можно найти поиском тут на сайте например вываливается такая тема
Лень двигатель прогресса, доказано!!!
 
Это в тему http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=64423&TITLE_SEO=64423-makros-dlya-transponirovaniya-dvumernogo-massiva-dannykh
Туда отправить никак не получается!
Код
Sub Che()
Dim i&, c As Range, rIn As Range, rOut As Range
Set rIn = Selection.Areas(1)
If rIn.Count < 2 Then
  MsgBox "Выделите прямоугольный диапазон и запустите снова", vbInformation
  Exit Sub
End If
Set rOut = Application.InputBox("Выделите ДВЕ первые ячейки столбца или строки для вставки", Type:=8)
If rOut.Columns.Count = 1 Then
  Set rOut = rOut.Cells(1)
  i = rIn.Rows.Count
  For Each c In rIn.Columns
    c.Copy rOut
    Set rOut = rOut.Offset(i)
  Next
ElseIf rOut.Rows.Count = 1 Then
  Set rOut = rOut.Cells(1)
  i = rIn.Columns.Count
  For Each c In rIn.Rows
    c.Copy rOut
    Set rOut = rOut.Offset(, i)
  Next
Else
  MsgBox "Было выделено более одной строки и столбца", vbCritical
End If
End Sub
Изменено: Казанский - 11.03.2015 10:58:15
 
Цитата
che написал: Только дайте наводку )
мы вам наводку, и вы нам НаВодку...
:)
 
если нужен именно макрос, то вот этот работает с выделением:
Скрытый текст
Изменено: Максим Зеленский - 11.03.2015 10:36:15
F1 творит чудеса
 
формулами так можно
 
Еще вариант.
Выделить прямоугольный диапазон с данными и выполнить макрос:
Код
Sub TransMass()
    Dim x As Range, i As Long, s As String, a(), b, c(): a = Selection.Value
    For i = 1 To UBound(a): s = s & "|" & Join(Application.Index(a, i, 0), "|"): Next
    b = Split(s, "|"): ReDim c(1 To UBound(b) + 1, 1 To 1)
    For i = 1 To UBound(b): c(i, 1) = b(i): Next
    Set x = Application.InputBox("Укажите начальную ячейку для вставки", Type:=8)
    If MsgBox("В столбец?", vbYesNo, "Ориентация") = vbNo Then
        x.Resize(, UBound(c)).Value = Application.Transpose(c)
    Else: x.Resize(UBound(c)).Value = c
    End If
End Sub
Изменено: SAS888 - 11.03.2015 11:57:53
Чем шире угол зрения, тем он тупее.
 
Большое всем спасибо. Все макросы и вариант с формулами - просто в самую точку. Вообще пока не нужно, но появилась мысль: транспонировать при помощи макроса не значения, а ссылки на ячейки. Как на счет такого варианта, есть какие нибудь решения на примете ?
 
Добрый день, еще один вариант транспонирования значений
Работает с выделеной областью:
Код
Sub test()
Dim a(), i%: ReDim a(Selection.Count)
For i = 1 To UBound(a): a(i) = Selection.Cells(i): Next i
' тут спрашиваем в столбец или строку транспонировать
[k10].Resize(UBound(a), 1) = Application.Transpose(a) ' в столбец
[k10].Resize(, UBound(a)) = a ' в строку
End Sub

 
Цитата
Vitallic написал: Добрый день, еще один вариант транспонирования значения
Макрос работает некорректно.
Изменено: che - 06.04.2015 12:53:43
 
Цитата
che написал: Макрос работает некорректно.
Специально сравнил работу макросов Казанский, Максим Зеленский, SAS888, так как:
Цитата
che написал: Большое всем спасибо. Все макросы и вариант с формулами - просто в самую точку.
результаты аналогичные с результатом работы моего макроса.
Единственный нюанс я использую Option Base 1, в их макросах по умолчанию этот параметр 0 что в принципе влияет на количество выводимых
элементов в итоговом массиве (на один меньше), а не на правильность его содержимого.
Или некорректность заключается в чем то другом?
 
Цитата
Vitallic написал: количество выводимых элементов в итоговом массиве (на один меньше)
только в этом проблема.
 
Цитата
che написал: итолько в этом проблема.
решение
установить Option Base 1перед макросом
 
Всем добрый день.
Как то без внимания остались еще два моих вопроса в этой теме, поэтому наберусь смелости задать их еще раз:
первый - транспонировать в одномерный массив не значения двумерного массива, а ссылки на ячейки?
второй -  может быть есть и макрос который транспонирует одномерный вертикальный или горизонтальный массив в двумерный  с предварительным указанием
количества столбцов или строк (смотря как транспонировать по вертикали или горизонтали)..
 
Цитата
che написал: Как то без внимания остались еще два моих вопроса в этой теме
так там по аналогии (результат вывел в окно отладки):
Код
Sub ttt()
Dim a(), x As Range, y%
ReDim a(Selection.Count)
For Each x In Selection
y = 1
a(y) = x.Cells.Address: y = y + 1
Debug.Print a(y - 1)
Next
End Sub

Цитата
che написал: второй -  может быть есть и макрос
давеча решал похожий вопрос вот ссылка, там сама логика, если что не сложно переделать под конкретную задачу
Изменено: Vitallic - 15.05.2015 11:48:19 (очепятка)
 
Vitallic, извините, я обычный пользователь и к сожалению информация от Вас для меня бесполезна.
 
Цитата
che написал: и к сожалению информация от Вас для меня бесполезна
пример к первому вопросу из поста #16 (с инструкцией что нажимать внутри файла)
 
Vitallic,
спасибо, как записать макрос в модуль и запустить его я знаю. Я может быть неправильно выразился в своем вопросе, но хотелось бы, чтобы в ячейке было видно значение, но через ссылки на дв. массив.
 
Цитата
che написал: чтобы в ячейке было видно значение, но через ссылки на дв. массив
вот теперь я не понимаю про какие ссылки идет речь
можете приложить пример как надо
 
Vitallic,
выложил пример.
 
Код
Sub ttt()
Dim a(), x As Range, y%: ReDim a(Selection.Count): y = 1
For Each x In Selection
a(y) = "=" & x.Cells.Address: y = y + 1
Next
Set x = Application.InputBox("Укажите начальную ячейку для вставки", Type:=8)
If MsgBox("В столбец?", vbYesNo, "Ориентация") = vbNo Then
x.Resize(, UBound(a) + 1).Value = a
Else
x.Resize(UBound(a) + 1).Value = Application.Transpose(a)
End If
End Sub


изменения в 4 строке
 
Vitallic,
спасибо. то что нужно.
а что по поводу вопроса "может быть есть и макрос который транспонирует одномерный вертикальный
или горизонтальный массив в двумерный  с предварительным указанием количества столбцов или строк (смотря как транспонировать по вертикали или горизонтали)". :))
 
Цитата
che написал: а что по поводу вопроса
у меня вышел вот такой "некрасивый" макрос. В принципе он решает задачу ТС, возможно есть некоторые нюансы, как например если в выделеную область попали пустые ячейки, то возвратятся нули - так нужно?
 
Vitallic,
добрый день. Не знаю почему Вы называете макрос "некрасивым", помоему все прекрасно работает )), именно это я и имел ввиду в своем вопросе.
То, что вместо пустых ячеек появляются нули, пока никаких проблем у меня не вызывает.
Большое спасибо за отзывчивость и за труд.
 
Vitallic,
возможно как то модернизировать макрос, чтобы по запросу он еще и пропускал пустые ячейки в двумерном массиве и в одномерном выдавал значения подряд.
Пример в приложении.
 
che, Вы в каждом сообщении обращаетесь к пользователю. Сами себе ограничиваете помощь от других.
 
Добрый день,
посмотрите такой вариант (в файле макрос ее2)

П.С. Прислушайтесь к совету vikttur,  возможно кто то уже бы выложил ответ  
 
Да, макрос то, что нужно. Но что хотелось бы в идеале: иметь один макрос и выбирать по запросу пропускать или не пропускать пустые ячейки, и чтобы макрос также считал за пустые ячейки где записано условие  ="".
Большое спасибо.
Страницы: 1 2 След.
Наверх