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

Вход

Регистрация

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

 

= Мир MS Excel/Перенос данных - Мир MS Excel

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

Здравствуйте!!!Помогите пожалуйста справится с задачей переноса из столбца В в столбец А но строкой ниже
Файл пример прилагается на 1листе(вставка) скидываются данные,на 2(итог)что должно получится
К сообщению приложен файл: perenos.xlsx(9Kb)
 
Ответить
СообщениеЗдравствуйте!!!Помогите пожалуйста справится с задачей переноса из столбца В в столбец А но строкой ниже
Файл пример прилагается на 1листе(вставка) скидываются данные,на 2(итог)что должно получится

Автор - gge29
Дата добавления - 16.07.2017 в 21:57
gge29 Дата: Воскресенье, 16.07.2017, 22:04 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 170
Репутация: 3 ±
Замечаний: 0% ±

А так приходиться добавлять строку между каждой и переносить данные из столбца В
 
Ответить
СообщениеА так приходиться добавлять строку между каждой и переносить данные из столбца В

Автор - gge29
Дата добавления - 16.07.2017 в 22:04
_Boroda_ Дата: Воскресенье, 16.07.2017, 22:21 | Сообщение № 3
Группа: Модераторы
Ранг: Местный житель
Сообщений: 11659
Репутация: 4831 ±
Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS
Не совсем понял - Вам на второй лист перенести нужно или на первом оставить?
Сделал 2 варианта
Это на второй лист
[vba]
Код
Sub tt()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Set sh1 = ThisWorkbook.Sheets("Вставка")
    Set sh2 = ThisWorkbook.Sheets("Итог")
    With sh1
        r1_ = .Range("A" & Rows.Count).End(3).Row
        ar1 = Range("A1").Resize(r1_, 2)
        ar2 = Range("A1").Resize(r1_ * 2)
        For i = 1 To r1_
            For j = 1 To 2
                ar2((2 * i - 1) + j - 1, 1) = ar1(i, j)
            Next j
        Next i
    End With
    With sh2
        .Columns(1).ClearContents
        .Range("A1").Resize(r1_ * 2) = ar2
        .Select
    End With
End Sub
[/vba]
К сообщению приложен файл: perenos_1.xlsm(20Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
 
Ответить
СообщениеНе совсем понял - Вам на второй лист перенести нужно или на первом оставить?
Сделал 2 варианта
Это на второй лист
[vba]
Код
Sub tt()
    Dim sh1 As Worksheet, sh2 As Worksheet
    Set sh1 = ThisWorkbook.Sheets("Вставка")
    Set sh2 = ThisWorkbook.Sheets("Итог")
    With sh1
        r1_ = .Range("A" & Rows.Count).End(3).Row
        ar1 = Range("A1").Resize(r1_, 2)
        ar2 = Range("A1").Resize(r1_ * 2)
        For i = 1 To r1_
            For j = 1 To 2
                ar2((2 * i - 1) + j - 1, 1) = ar1(i, j)
            Next j
        Next i
    End With
    With sh2
        .Columns(1).ClearContents
        .Range("A1").Resize(r1_ * 2) = ar2
        .Select
    End With
End Sub
[/vba]

Автор - _Boroda_
Дата добавления - 16.07.2017 в 22:21
AndreTM Дата: Воскресенье, 16.07.2017, 22:25 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 1762
Репутация: 496 ±
Замечаний: 0% ±

2003 & 2010
А обязательно "макросом"? :)
К сообщению приложен файл: 2775565.xlsx(9Kb)


Skype: andre.tm.007
Donate: Qiwi: 9517375010
 
Ответить
СообщениеА обязательно "макросом"? :)

Автор - AndreTM
Дата добавления - 16.07.2017 в 22:25
gge29 Дата: Воскресенье, 16.07.2017, 22:29 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 170
Репутация: 3 ±
Замечаний: 0% ±

Александр спасибо!!!То что надо
 
Ответить
СообщениеАлександр спасибо!!!То что надо

Автор - gge29
Дата добавления - 16.07.2017 в 22:29
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Перенос данных (Макросы/Sub)
Страница 1 из 11
Поиск:

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