Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Объединение/подстановка нескольких столбцов в один
 
Здравствуйте, коллеги.

Прошу помочь вот в какой задаче.
Есть несколько столбцов «200+» и их надо сделать одним столбцом. Файл в приложении.
Спасибо за помощь кто отзовется.
 
Наверно так..
 
Код
Sub test()
Dim i&, j%
On Error Resume Next
j = Cells(1, Columns.Count).End(xlToLeft).Column
For i = 1 To j
    If i = 1 Then
        Range(Cells(1, i), Cells(1, i).End(xlDown)).Copy _
            Cells(Cells(Rows.Count, j + 2).End(xlUp).Row, j + 2)
    Else: Range(Cells(1, i), Cells(1, i).End(xlDown)). _
            Copy Cells(Cells(Rows.Count, j + 2).End(xlUp).Row + 1, j + 2)
    End If
Next i
End Sub
"Все гениальное просто, а все простое гениально!!!"
 
а формулы с такой задачей справятся?
 
Доброго дня
@copper-top думаю что для формулы это задача не по "зубам". Хотя не мне судить.
@Nordheim Спасибо огромное! Макрос задачу решает полностью 250+ столбцов и не одного лога!
@AAF Спасибо что откликнулись. Макрос дает ошибку. Я посмотрел вот тут. Тем не менние спасибо за саппопрт.
Код
Sub GlueArray()
Dim a, aRezult, i As Long, j As Long, k As Long, sh As Worksheet, rng As Range
Set rng = Sheets("Лист1").Cells(1, 1).CurrentRegion [B]'тут дает ошибку Run time error 9[/B]
a = rng.Value
ReDim aRezult(1 To UBound(a) * UBound(a, 2), 1 To 1)
For j = 1 To UBound(a, 2)
  For i = 1 To UBound(a)
    If a(i, j) <> Empty Then
      k = k + 1
      aRezult(k, 1) = a(i, j)
    End If
  Next
Next
Set sh = Sheets.Add
sh.Name = Format(Now, "yymmdd_hhmmss")
sh.Cells(1).Resize(k) = aRezult
End Sub

Спасибо Всем за поддержку
Алекс Д.
 
Цитата
Alexandr Dumanetskiy написал:
Set rng = Sheets("Лист1").Cells(1, 1).CurrentRegion 'тут дает ошибку Run time error 9
Название листа должно соответствовать и Cells(row,column) должна принадлежать таблице  ;)
Изменено: AAF - 19 Июн 2017 20:04:55
 
Alexandr Dumanetskiy, код следует оформлять соответствующим тегом - посмотрите, как это выглядит у других. Ищите такую кнопку и исправьте своё сообщение.
Тег VBA.jpg (19.2 КБ)
 
Цитата
Alexandr Dumanetskiy написал: думаю что для формулы это задача не по "зубам".
Плохо о формулах думаете :)
Сначала находим граничные значения:
=СЧЁТЕСЛИ(A:A;"*")+A1
Потом работаем:
=ИНДЕКС($A$2:$D$10;СТРОКА(A2)-ПРОСМОТР(СТРОКА(A1);$A$1:$D$1);ПОИСКПОЗ(СТРОКА(A1);$A$1:$D$1))
 
vikttur, спасибо. ложу в коллекцию решений.
Страницы: 1
Читают тему (гостей: 2)