Коприрование строк из массива

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Коприрование строк из массива (Макросы/Sub)

zegor

Дата: Суббота, 14.11.2015, 13:19 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 132

Репутация: 1 ±

Замечаний: 0% ±

Excel 2007

Доброго дня уважаемые знатоки VBA)
Решить мою "тему" возможно и формульно, но очень уж громоздко получается (более пятисот строк исходных данных в масиве). По сему прошу помощи в этом разделе .

Суть. Требуется копировать массивы, с листа "One" на "Two" в изначальном порядке (в смысле как они расположены сверху вниз так и укладывать). Данные за которые будет необходимо цепляться распологаются в массиве "A:B". Например копируем данные "b2". Первый массив для копирования определяем "A5:G5", второй "A15:G15", третий "A19:G19" и так далее. Таким же образом "b3", "b4" и все остальные.

Надеюсь на вашу помощь.

К сообщению приложен файл: 3054392.xls (52.0 Kb)

Ответить

Kuzmich

Дата: Суббота, 14.11.2015, 15:22 | Сообщение № 2

Группа: Проверенные

Ранг: Ветеран

Сообщений: 712

Репутация: 156 ±

Замечаний: 0% ±

Excel 2003

В модуль листа One
[vba]

Код

Sub Perenos()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim MyArr
Dim Found_b As Range
Dim iAdr As String
   MyArr = Array("b1", "b2", "b3", "b4", "b5", "b6", "b7", "b8", "b9")
   With Worksheets("Two")
    .Cells.Clear
    j = 1
     For i = 0 To UBound(MyArr)
       Set Found_b = Columns("A:B").Find(MyArr(i), , xlValues, xlWhole)
       iAdr = Found_b.Address
         k = 1
        Do
          Range(Cells(Found_b.Row, 1), Cells(Found_b.Row, 7)).Copy .Cells(k, j)
         Set Found_b = Columns("A:B").FindNext(Found_b)
         k = k + 1
        Loop While Found_b.Address <> iAdr
        j = j + 8
     Next
   End With
End Sub

[/vba]

Ответить

zegor

Дата: Суббота, 14.11.2015, 16:27 | Сообщение № 3

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 132

Репутация: 1 ±

Замечаний: 0% ±

Excel 2007

Kuzmich, большое спасибо! Но дело в том, что в больших масштабах не работает. Подскажите пожалуйста какмим образом переиначить ваш код дабы обработать вот это (с учётом "а" тоже, не только "b").

При попытке вписать в код варианты с "а" неизменно получаю "Object variable or With block variable not set". Конечно мне руки за такое поотбивать, но VBA для меня "тёмный лес"

К сообщению приложен файл: 00000.xls (70.0 Kb)

Сообщение отредактировал zegor - Суббота, 14.11.2015, 16:38

Ответить

Kuzmich

Дата: Суббота, 14.11.2015, 16:46 | Сообщение № 4

Группа: Проверенные

Ранг: Ветеран

Сообщений: 712

Репутация: 156 ±

Замечаний: 0% ±

Excel 2003

Впишите в код
[vba]

Код

MyArr = Array("b1", "b2", "b3", "b4", "b5", "b6", "b7", "b8", "b9")

[/vba]
значения "a1", "a2" и т.д.

Ответить

zegor

Дата: Суббота, 14.11.2015, 16:52 | Сообщение № 5

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 132

Репутация: 1 ±

Замечаний: 0% ±

Excel 2007

Kuzmich, всё та же "Object variable or With block variable not set". Может не верно вас понял, файлик прикладываю.
[vba]

Код

Sub Perenos()
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim MyArr
Dim Found_b As Range
Dim iAdr As String
MyArr = Array("b1", "b2", "b3", "b4", "b5", "b6", "b7", "b8", "b9", "a1", "a2", "a3", "a4", "a5", "a6", "a7", "a8", "a9")
With Worksheets("Two")
    .Cells.Clear
    j = 1
    For i = 0 To UBound(MyArr)
    Set Found_b = Columns("A:B").Find(MyArr(i), , xlValues, xlWhole)
    iAdr = Found_b.Address
        k = 1
        Do
        Range(Cells(Found_b.Row, 1), Cells(Found_b.Row, 7)).Copy .Cells(k, j)
        Set Found_b = Columns("A:B").FindNext(Found_b)
        k = k + 1
        Loop While Found_b.Address <> iAdr
        j = j + 8
    Next
End With
End Sub

[/vba]