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

Вход

Регистрация

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

 

= Мир MS Excel/Упорядочить данные из таблиц - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Упорядочить данные из таблиц (Макросы/Sub)
Упорядочить данные из таблиц
bosika Дата: Суббота, 17.09.2016, 10:54 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 105
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010, 2013, 2016
Добрый день ГУРУ.

Как можно программно транспортировать циклом данные. На лист выводятся данные в столбик, нужно их транспортировать как в примере. Билетов при этом может быть до 100 а то и более. Заранее благодарен.
К сообщению приложен файл: 8520629.xlsx (11.4 Kb)

Начинающий. Много и долго не пинать. Больно однако.

Сообщение отредактировал bosika - Суббота, 17.09.2016, 11:33
 
Ответить
СообщениеДобрый день ГУРУ.

Как можно программно транспортировать циклом данные. На лист выводятся данные в столбик, нужно их транспортировать как в примере. Билетов при этом может быть до 100 а то и более. Заранее благодарен.
Автор - bosika
Дата добавления - 17.09.2016 в 10:54
nilem Дата: Суббота, 17.09.2016, 12:22 | Сообщение № 2
Группа: Авторы
Ранг: Старожил
Сообщений: 1613
Репутация: 563 ±
Замечаний: 0% ±

Excel 2013, 2016
bosika, привет
попробуйте так:
[vba]
Код
Sub ertert()
Dim r As Range, rw&, cnt&
rw = 3
With Application
    For Each r In Range("B <img rel="usm" src="/sml2/biggrin.gif" border="0" align="absmiddle" alt=" <img rel="usm" src="/sml2/biggrin.gif" border="0" align="absmiddle" alt=" <img rel="usm" src="/sml2/biggrin.gif" border="0" align="absmiddle" alt=":D" /> " /> " /> ").SpecialCells(2).Areas
        r.Copy
        Cells(rw, 8).PasteSpecial xlPasteValues, , , True
        Cells(rw - 1, 7).Resize(4).Value = .Transpose(Array("Билет " & cnt, _
                    "Вопрос", "№ вопроса", "Ответ"))
        rw = rw + 5: cnt = cnt + 1
    Next
End With
End Sub
[/vba]

что-то с тегами случилось, видимо
непонятная строка должна быть так: For Each r In Range("B :D ").SpecialCells(2).Areas

и опять косяк :)
Range(" B : D ")

Яндекс.Деньги 4100159601573

Сообщение отредактировал nilem - Суббота, 17.09.2016, 12:25
 
Ответить
Сообщениеbosika, привет
попробуйте так:
[vba]
Код
Sub ertert()
Dim r As Range, rw&, cnt&
rw = 3
With Application
    For Each r In Range("B <img rel="usm" src="/sml2/biggrin.gif" border="0" align="absmiddle" alt=" <img rel="usm" src="/sml2/biggrin.gif" border="0" align="absmiddle" alt=" <img rel="usm" src="/sml2/biggrin.gif" border="0" align="absmiddle" alt=":D" /> " /> " /> ").SpecialCells(2).Areas
        r.Copy
        Cells(rw, 8).PasteSpecial xlPasteValues, , , True
        Cells(rw - 1, 7).Resize(4).Value = .Transpose(Array("Билет " & cnt, _
                    "Вопрос", "№ вопроса", "Ответ"))
        rw = rw + 5: cnt = cnt + 1
    Next
End With
End Sub
[/vba]

что-то с тегами случилось, видимо
непонятная строка должна быть так: For Each r In Range("B :D ").SpecialCells(2).Areas

и опять косяк :)
Range(" B : D ")
Автор - nilem
Дата добавления - 17.09.2016 в 12:22
Kuzmich Дата: Суббота, 17.09.2016, 12:25 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
Макрос
[vba]
Код

Sub Bilet()
Dim FoundBilet As Range
Dim FAdr As String
Dim n As Integer
Dim RowEnd As Integer
  Set FoundBilet = Columns(1).Find("Билет", , xlValues, xlPart)
    FAdr = FoundBilet.Address
    n = 2
    Do
      RowEnd = Cells(FoundBilet.Row + 1, 2).End(xlDown).Row
         Cells(n, 7) = FoundBilet
         Cells(n + 1, 7) = "Вопрос"
         Cells(n + 2, 7) = "№ вопроса"
         Cells(n + 3, 7) = "Ответ"
       Range(Cells(FoundBilet.Row + 1, 2), Cells(RowEnd, 4)).Copy
       Cells(n + 1, 8).PasteSpecial Transpose:=True
       Set FoundBilet = Columns(1).Find("Билет", After:=FoundBilet)
         n = n + 5
    Loop While FoundBilet.Address <> FAdr
End Sub
[/vba]
Границы в транспонированных таблицах в коде попробуйте прописать сами
 
Ответить
СообщениеМакрос
[vba]
Код

Sub Bilet()
Dim FoundBilet As Range
Dim FAdr As String
Dim n As Integer
Dim RowEnd As Integer
  Set FoundBilet = Columns(1).Find("Билет", , xlValues, xlPart)
    FAdr = FoundBilet.Address
    n = 2
    Do
      RowEnd = Cells(FoundBilet.Row + 1, 2).End(xlDown).Row
         Cells(n, 7) = FoundBilet
         Cells(n + 1, 7) = "Вопрос"
         Cells(n + 2, 7) = "№ вопроса"
         Cells(n + 3, 7) = "Ответ"
       Range(Cells(FoundBilet.Row + 1, 2), Cells(RowEnd, 4)).Copy
       Cells(n + 1, 8).PasteSpecial Transpose:=True
       Set FoundBilet = Columns(1).Find("Билет", After:=FoundBilet)
         n = n + 5
    Loop While FoundBilet.Address <> FAdr
End Sub
[/vba]
Границы в транспонированных таблицах в коде попробуйте прописать сами
Автор - Kuzmich
Дата добавления - 17.09.2016 в 12:25
bosika Дата: Суббота, 17.09.2016, 12:32 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 105
Репутация: 0 ±
Замечаний: 40% ±

Excel 2010, 2013, 2016
Огромное спасибо ребята. Все работает. Тему можно закрывать.

Начинающий. Много и долго не пинать. Больно однако.
 
Ответить
СообщениеОгромное спасибо ребята. Все работает. Тему можно закрывать.
Автор - bosika
Дата добавления - 17.09.2016 в 12:32
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Упорядочить данные из таблиц (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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