Страницы: 1
RSS
Скопировать непустые ячейки дипазона в другой диапазон друг за другом
 
Добрый день уважаемые формучане.
Не получается написать макрос, таким образом, чтобы сперва он просматривал диапазон на предмет непустых ячеек, а после этого копировал непустые ячейки в другой диапазон вставляя их друг за другом.

Код, которым пробовал это сделать приложен.
Код
For Each cell In ActiveSheet.UsedRange.Range("AG5:BE5") 'задаю диапазон проверки
        If cell.Value <> 0 Then ActiveCell.Copy ' если удовлетворяет требованиям копирую
    Windows("Книга1.xls").Activate 'активирую другую книгу
    I = 15 'задаю переменную для поиска непустой ячейкии в нужном диапазоне
    Do While Range("C" & I) <> "" 'ищу первую непустую строку
    I = I + 1
    Loop
    Range("C" & I).Select 'выделяю ее
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False 'вставляю значение из первого диапазона
    ThisWorkbook.Activate 'возвращаюсь  в первую книгу
    Next
Если еще подскажете как органичить проверку во второй книге диапазоном "C15:С29" буду оочччень признателен.
 
Добрый день. Код неполный, поэтому непонятно, что именно вызывает затруднение?
Находить последнюю заполненную ячейку можно через метод End(xlDown/xlUp) и т.д.
Например, у нас заполнены подряд ячейки в столбце А, начиная с 1 строки. Заполнены больше 1, но сколько точно не знаем. Как определить первую "пустую" ячейку в столбце А? А вот:
Код
'методом End "спускаемся" на последнюю заполненную ячейку в столбце, и потом еще на одну строку через метод Offset
Range("A1").End(xlDown).Offset(1,0)
Что касается задачи - я бы вообще решал либо через массивы (забрать все исходные данные в массив, пробежаться по нему, выявить непустые значения, занести их в выходной массив без пропусков - выгрузить выходной массив), либо (если уж copy-pastespecial необходимы) можно еще через метод Find - FindNext решить (и тут можно ограничить диапазон, в котором будем искать непустые значения). В справке по методу Range.Find, Range.FindNext как раз есть пример цикла с использованием этих конструкций.
Изменено: Пытливый - 10.03.2020 18:04:15
Кому решение нужно - тот пример и рисует.
 
Пытливый,
Цитата
Пытливый написал:
Код неполный, поэтому непонятно, что именно вызывает затруднение?
Действительно это лишь часть когда. Но остальной код никаким образом не влияет на него. Так что можно считать, что это весь макрос.

Цитата
Пытливый написал:
Например, у нас заполнены подряд ячейки в столбце А, начиная с 1 строки. Заполнены больше 1, но сколько точно не знаем. Как определить первую "пустую" ячейку в столбце А? А вот:
А если А1 тоже пустая? поясню: диапазон C15:С29 фиксированный. Больше или меньше строк и колонок не будет. Диапазон AG5:BE5 тоже фиксированный.
Но изначально в шаблоне C15:С29 пустые.

Цитата
Пытливый написал: Что касается задачи - я бы вообще решал либо через массивы..., либо ...через метод Find - FindNext
Я попробую черех FindNext, так как масивы для меня сложнее. Если только вы мне не подскажете как =)
 
Подсказывать как лучше в условиях наличия примера - вот сейчас есть так, вот должно стать сяк. Не обязательно 2 книги, можно пример сделать на двух листах (уж как в другую книгу переносить, разберетесь).
Пример - это файл excel с небольшим количеством исходных данный и желаемым результатом, если чего... :)
Кому решение нужно - тот пример и рисует.
 
Сделал в итоге вот таким образом:
Код
For Each Cell In ActiveSheet.UsedRange.Range("AG5:BE5").Cells
        If Cell.Value > "0" Then Cell.Copy
    Windows("Книга1.xls").Activate
    Dim myPhrase As Variant, myCell As Range
    myPhrase = ""
    Set myCell = Range("C14:C29").Find(myPhrase, LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
    If Not myCell Is Nothing Then
    myCell.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    End If
    ThisWorkbook.Activate
    Next
Единственное что, пришлось задать диапазон поиска с С14, а это выходит за пределы диапазона нужных мне ячеек. Почему то не хочет он прям с первой ячейки искать. Может изза SearchDirection:=xlNext. Ну да ладно.
 
Цитата
Почему то не хочет он прям с первой ячейки искать.
Попробуйте так
Код
With Range("C15:C29")
  Set myCell = .Find(myPhrase, .Cells(.Cells.Count), xlValues, xlWhole, , xlNext)
End With   
 
Спасибо Kuzmich, помогло.
Страницы: 1
Наверх