Главная Вход в систему Регистрация
Задать вопрос Консультации Пользователи Форум
О системе Помощь
Задать вопрос экспертам
Консультация № 180606
07.11.2010, 19:00
0.00 руб.
0 2 1
Компьютеры Программирование
Нужна программа на VBA. В верхнем левом углу листа Excel есть заполненная таблица. В каждой строке - несколько пустых ячеек. Теперь условно назовём таблицу до обработки программы старой таблицей, а после - новой таблицей. Нужно попарно поменять местами все строки. Причём у каждой строки новой таблицы должно удаляться содержимое из той ячейки, которая была пуста для этой строки старой таблицы. То есть в новой таблице изменён порядок слов, а количество пустых ячеек в 2 раза больше. денежное вознаграждение за написание кода.

Обсуждение

давно
Megaloman
Модератор
137394
1850
07.11.2010, 23:38
общий
это ответ
Здравствуйте, igor!
Код:
MaxCol = "IV"                                       'Имя последнего столбца
NCol = Columns(MaxCol).Column

Out = True
i = 1

Do While Out
   Out = False
   For j = 1 To NCol
        M1 = Cells(2 * i - 1, j)
        M2 = Cells(2 * i, j)
        
        L1 = (M1 = "")
        L2 = (M2 = "")
        
        If L1 Then M2 = ""
        If L2 Then M1 = ""
        
        Cells(2 * i - 1, j) = M2
        Cells(2 * i, j) = M1
        
        Out = Out Or Not L1 Or Not L2
   Next
   i = i + 1
Loop
Макрос будет работать на активном листе до тех пор, пока не встретятся обе пустые парные строки. Если желательно другой принцип завершения макроса, пишите.
А вот более эффективное решение задачи - за счёт обмена данными через массив
Код:
     MaxCol = "IV"               'Имя последнего обрабатываемого столбца
    N = Columns(MaxCol).Column
    
    Dim M1 As Variant
    Dim M2 As Variant
    Dim R As Range
    Set R = Range("A1:" + MaxCol + "1")
    
    Out = True
    i = 1
    Do While Out
        Out = False
        
        M1 = R.Offset(2 * i - 2, 0)
        M2 = R.Offset(2 * i - 1, 0)
        
        For j = 1 To N
            L1 = (M1(1, j) = "")
            L2 = (M2(1, j) = "")
            
            If L1 Then M2(1, j) = ""
            If L2 Then M1(1, j) = ""
            
            Out = Out Or Not L1 Or Not L2
        Next
            
        R.Offset(2 * i - 2, 0) = M2
        R.Offset(2 * i - 1, 0) = M1
        
        i = i + 1
    Loop
По результату оба макроса эквивалентны
Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет
давно
Megaloman
Модератор
137394
1850
08.11.2010, 11:21
общий
Добавил еще один вариант решения
Об авторе:
Понеже не словес красных бог слушает, но дел наших хощет
Форма ответа