Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Сдвиг одной ячейки пока в другой есть данные
 
Здравствуйте форумчане, подскажите быстрое решение такой задачи: нужно сдвигать все ячейки в столбцах G,H,I пока ячейка B не пустая
Пример:
1. было

2. Стало:

Можно без удаления пустых строк
 
Удаление пустых строк - довольно стандартный макрос, в сети найти просто.
Чтобы можно было сделать без удаления, прикрепите файл с исходными данными. Если данные важные - придумайте любую абракадабру.
Изменено: Все_просто - 13 Апр 2015 00:03:35
С уважением,
Федор/Все_просто
 
Ну в идеале конечно и пустые строки поудалять
http://rghost.ru/8XyMyMrhX
Изменено: laven - 13 Апр 2015 08:01:58
 
laven, посмотрите на своё сообщение - так ли нужно было цитировать, да и ещё целиком всё сообщение? Просто ОТВЕТИТЬ нельзя было? Кнопка цитирования НЕ ДЛЯ ответа. Исправьте.
 
Какой-то странный файл. Сделал для одной области:
Код
Option Explicit
Sub delRng(rngWhole As Range)
    Dim lngRows As Long: lngRows = rngWhole.Rows.Count
    Dim lngCols As Long: lngCols = rngWhole.Columns.Count
    Dim lngCol As Long
    Dim rngToDelete As Range
    Dim lngToInsert As Long
    Dim rngToInsert As Range
    
    For lngCol = 3 To lngCols
    
        On Error Resume Next
        Set rngToDelete = rngWhole.Columns(lngCol).SpecialCells(xlCellTypeBlanks)
        On Error GoTo 0
        If Not rngToDelete Is Nothing Or Err = 0 Then 'And rngToDelete.Rows.Count <> lngRows Then
'            rngToDelete.Select

            lngToInsert = rngToDelete.Cells.Count
            rngToDelete.Delete xlUp
            Set rngToInsert = rngWhole(lngRows - lngToInsert + 1, lngCol).Resize(lngToInsert)
'            rngToInsert.Select
            rngToInsert.Insert xlShiftDown
        Else
            Err.Clear
        End If

    Next
End Sub
Sub main()
    Dim rng As Range
    Dim cell As Range
    Set rng = Application.InputBox("Enter some range", Type:=8)
    For Each cell In rng.Cells
        cell = Trim(cell)
    Next cell
    Call delRng(rng)
End Sub
Изменено: Все_просто - 13 Апр 2015 09:24:23
С уважением,
Федор/Все_просто
Страницы: 1
Читают тему (гостей: 1)