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

Вход

Регистрация

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

 

= Мир MS Excel/Перенос ячеек на листе - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос ячеек на листе (Макросы/Sub)
Перенос ячеек на листе
fairylive Дата: Вторник, 27.09.2016, 19:01 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 3 ±
Замечаний: 0% ±

Excel 2016
Всем привет. Споткнулся тут с простой задачей. Завис уже часа на три.
Вобщем есть таблица исходных данных в виде 1 строки и 100500 столбцов. Нужно сделать таблицу в два столбца и 100500/2 строк. Принцип такой: первые две ячейки остаются на месте, следующая пара ячеек переезжает под них и так далее.
Прикладываю свой файл. Там какой-то из последних сырых вариантов.
К сообщению приложен файл: 0245582.xlsm(18Kb)
 
Ответить
СообщениеВсем привет. Споткнулся тут с простой задачей. Завис уже часа на три.
Вобщем есть таблица исходных данных в виде 1 строки и 100500 столбцов. Нужно сделать таблицу в два столбца и 100500/2 строк. Принцип такой: первые две ячейки остаются на месте, следующая пара ячеек переезжает под них и так далее.
Прикладываю свой файл. Там какой-то из последних сырых вариантов.

Автор - fairylive
Дата добавления - 27.09.2016 в 19:01
Pelena Дата: Вторник, 27.09.2016, 19:35 | Сообщение № 2
Группа: Модераторы
Ранг: Экселист
Сообщений: 9856
Репутация: 2254 ±
Замечаний: 0% ±

Excel 2010 & Mac Excel 2011
Здравствуйте.
А формулой не хотите?
Код
=ИНДЕКС($C$1:$ADD$1;СТРОКА(A1)*2-1)

Потом можно Копировать/Вставить как значения
К сообщению приложен файл: 4511814.xlsm(25Kb)


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеЗдравствуйте.
А формулой не хотите?
Код
=ИНДЕКС($C$1:$ADD$1;СТРОКА(A1)*2-1)

Потом можно Копировать/Вставить как значения

Автор - Pelena
Дата добавления - 27.09.2016 в 19:35
RAN Дата: Вторник, 27.09.2016, 19:46 | Сообщение № 3
Группа: Друзья
Ранг: Участник клуба
Сообщений: 4277
Репутация: 829 ±
Замечаний: 0% ±

2010
[vba]
Код
Sub qq()
j = 2
    For i = 3 To Columns(Columns.Count).End(xlToLeft).Column Step 2
        Cells(j, 1).Resize(, 2).Value = Cells(1, i).Resize(, 2).Value
        j = j + 1
    Next
End Sub
[/vba]


Быть или не быть, вот в чем загвоздка!
 
Ответить
Сообщение[vba]
Код
Sub qq()
j = 2
    For i = 3 To Columns(Columns.Count).End(xlToLeft).Column Step 2
        Cells(j, 1).Resize(, 2).Value = Cells(1, i).Resize(, 2).Value
        j = j + 1
    Next
End Sub
[/vba]

Автор - RAN
Дата добавления - 27.09.2016 в 19:46
Karataev Дата: Вторник, 27.09.2016, 19:54 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 641
Репутация: 226 ±
Замечаний: 0% ±

Excel
[vba]
Код
Sub Разнести_по_строкам()

    Dim arr1(), arr2(), lc As Long, i As Long, j As Long
    
    lc = Rows(1).Find(What:="*", LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Column
    arr1() = Range("A1").Resize(1, lc).Value
    ReDim arr2(1 To UBound(arr1, 2) / 2, 1 To 2)
    
    i = 0
    For j = 1 To UBound(arr1, 2) Step 2
        i = i + 1
        arr2(i, 1) = arr1(1, j)
        arr2(i, 2) = arr1(1, j + 1)
    Next
    
    Range("A1").Resize(UBound(arr2), UBound(arr2, 2)).Value = arr2()

End Sub
[/vba]


 
Ответить
Сообщение[vba]
Код
Sub Разнести_по_строкам()

    Dim arr1(), arr2(), lc As Long, i As Long, j As Long
    
    lc = Rows(1).Find(What:="*", LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False _
        , SearchFormat:=False).Column
    arr1() = Range("A1").Resize(1, lc).Value
    ReDim arr2(1 To UBound(arr1, 2) / 2, 1 To 2)
    
    i = 0
    For j = 1 To UBound(arr1, 2) Step 2
        i = i + 1
        arr2(i, 1) = arr1(1, j)
        arr2(i, 2) = arr1(1, j + 1)
    Next
    
    Range("A1").Resize(UBound(arr2), UBound(arr2, 2)).Value = arr2()

End Sub
[/vba]

Автор - Karataev
Дата добавления - 27.09.2016 в 19:54
_Boroda_ Дата: Вторник, 27.09.2016, 19:59 | Сообщение № 5
Группа: Модераторы
Ранг: Экселист
Сообщений: 9362
Репутация: 3935 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
И такой простенький вариант
[vba]
Код
Sub упорядочить()
    For i = 1 To Cells(1, Columns.Count).End(xlToLeft).Column Step 2
        n_ = Not n_
        Cells(2, Int(i / 4) * 2 + 1).Offset(1 + n_).Resize(, 2) = Cells(1, i).Resize(, 2).Value
    Next i
End Sub
[/vba]

Если добавить нужностей всяких, то
[vba]
Код
Sub упорядочить()
    Dim n_ As Boolean
    Application.ScreenUpdating = 0
    cal_ = Application.Calculation
    Application.Calculation = xlCalculationManual
    c1_ = Cells(1, Columns.Count).End(xlToLeft).Column
    For i = 1 To c1_ Step 2
        n_ = Not n_
        Cells(2, Int(i / 4) * 2 + 1).Offset(1 + n_).Resize(, 2) = Cells(1, i).Resize(, 2).Value
    Next i
    Application.Calculation = cal_
    Application.ScreenUpdating = 1
    MsgBox "Всё"
End Sub
[/vba]


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеИ такой простенький вариант
[vba]
Код
Sub упорядочить()
    For i = 1 To Cells(1, Columns.Count).End(xlToLeft).Column Step 2
        n_ = Not n_
        Cells(2, Int(i / 4) * 2 + 1).Offset(1 + n_).Resize(, 2) = Cells(1, i).Resize(, 2).Value
    Next i
End Sub
[/vba]

Если добавить нужностей всяких, то
[vba]
Код
Sub упорядочить()
    Dim n_ As Boolean
    Application.ScreenUpdating = 0
    cal_ = Application.Calculation
    Application.Calculation = xlCalculationManual
    c1_ = Cells(1, Columns.Count).End(xlToLeft).Column
    For i = 1 To c1_ Step 2
        n_ = Not n_
        Cells(2, Int(i / 4) * 2 + 1).Offset(1 + n_).Resize(, 2) = Cells(1, i).Resize(, 2).Value
    Next i
    Application.Calculation = cal_
    Application.ScreenUpdating = 1
    MsgBox "Всё"
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 27.09.2016 в 19:59
fairylive Дата: Среда, 28.09.2016, 14:07 | Сообщение № 6
Группа: Пользователи
Ранг: Участник
Сообщений: 87
Репутация: 3 ±
Замечаний: 0% ±

Excel 2016
Всем большое спасибо! Пока наиболее понятный вариант от товарища RAN. Так даже проще чем я думал.
 
Ответить
СообщениеВсем большое спасибо! Пока наиболее понятный вариант от товарища RAN. Так даже проще чем я думал.

Автор - fairylive
Дата добавления - 28.09.2016 в 14:07
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос ячеек на листе (Макросы/Sub)
Страница 1 из 11
Поиск:

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