Копирование ячеек с определенной позиции и с одного листа на другой в VBA

Pyatnitsev 5 комментариев

Вот такое дали:

Копировать клетки столбца D, начиная с клетки D5, с Листа 2 на Лист 1 до тех пор, пока сумма копируемых значений не станет больше 100.

Решить на VBA, в Excel соответственно.

Задача показалась ну сильно простой, однако, на ее решение ушло значительное время.

Код получился таким:

[VB]

Option Explicit ‘ Обязательное оъявление данных
Sub CopyPrj() ‘ Заголовок программы
‘ Объявление переменных

Dim sum As Single
Dim i As Integer
Dim oRange2  As Range
sum = 0
i = 5
Sheets(«Лист2»).Activate

Do While (sum <= 100)

Set oRange2 = Worksheets(«Лист2»).Cells(i, 4)

oRange2.Select
Selection.Copy Worksheets(«Лист1»).Cells(i — 4, 1)

sum = sum + oRange2.Value
i = i + 1

Loop

End Sub ‘ Конец программы

[/VB]

На чем хотелось бы заострить внимание:

Объект Range.

[VB]

Set oRange2 = Worksheets(«Лист2»).Cells(i, 4)

oRange2.Select

[/VB]

Такое допустимо только если текущий лист именно второй, поэтому пришлось добавить строчку

[VB]Sheets(«Лист2»).Activate[/VB]

И, таким образом, при начале работы скрипта всегда выбирается второй лист и ошибка не возникает, ну а куда копировать-ему не сильно интересно, поэтому выбирать обратно первый лист при копировании туда не пришлось.

[VB]Selection.Copy Worksheets(«Лист1»).Cells(i — 4, 1)[/VB]

В этой строке изменен индекс, сделано просто для того, чтобы вставлялось в первую ячейку первого листа.

Файл в котором писалось приложение

Похожие записи:

  1. Работа с матрицей в VBA
  2. VBA, Раскрасить матрицу
  3. VBA: Выделить слова в Microsoft Word

5 Responses

  1. Pyatnitsev 11.11.2011 / 14:48

    Обнаружил ошибку

    не верна задана сумма. Изначально стояло значение 1, теперь:

    sum = 0

  3. Василий 19.12.2013 / 16:23

    Попробовал применить указанный вариант в своей схеме, выдает ошибку.
    Подскажите, пожалуйста, что я не так делаю
    (данный макрос при удалении строк — заполнении ячеек столбца «В» листа «Команды» должен добавлять их в столбец «В» листа «Командный результат»
    Private Sub CommandButton1_Click()
    Sheets(«Командный результат»).Visible = True
    Sheets(«Таблица соревнования»).Visible = True ‘в рабочей версии False
    Sheets(«Командный результат»).Activate
    Sheets(«Команды»).Visible = True ‘в рабочей версии False
    Sheets(«Группы»).Visible = True ‘в рабочей версии False
    CopyPast
    End Sub

    Sub CopyPast()
    Dim n As Integer
    Dim m As Integer
    Dim oRange2 As Range
    For n = 2 To 22 Step 1
    m = n + 2

    Set oRange2 = Worksheets(«Команды»).Cells(n, 2)

    oRange2.Copy Worksheets(«Командный результат»).Cells(m, 2)
    Next n

    End Sub

Добавить комментарий