Страницы: 1
RSS
Перенос строк в самый вверх, под заголовки, по значению в ячейке
 
Добрый день!
Подскажите как можно реализовать перенос строк автоматически по значению в ячейке?
Знаю, что это можно сделать через Макросы, пыталась написать, но у меня вышло не совсем то, что надо

Строка должна перемещаться по значению в столбце I по слову "оплачено".
Буду благодарна за помощь
Спасибо!
 
увааемая Griz,
вместо того чтобы рассказывать как у вас не получилось - расскажите какую задачу решаете
есть вот это и это, нужно получить вот что
когда всем будет понятно "вот это" и "вот что" кто-то решит вашу задачу, а пока нет четких условий - решайте ее самостоятельно
Изменено: Ігор Гончаренко - 19.05.2022 21:42:34
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
написал:
Ігор Гончаренко
Да, простите, возможно я как то не подробно написала

Необходимо осуществить автоматический перенос строк вверх по значению в столбце "I" (статус)
Если в столбце "I" (статус) пишется слово "оплачено", то вся строка (А:J) должна переместиться вверх под шапку таблицы действующего листа в строку 3
 
1. ставите курсор куда-нибудь в вашу таблицу
2. Лента Данные, группа Сортировка и фильтры, кнопка Сортировка
3. в открывшемся окне
4. в поле "Сортировать по" выбираете статус
5. в поле Порядок, выбираете Настраиваемый список
6. в открывшемся окне в поле Элементы списка пишете оплачено
7. Ок
8. Ок
_________________________________
оплачено - в верхних строках таблицы
благодарностей не нужно
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Цитата
написал:
1. ставите курсор куда-нибудь в вашу таблицу
2. Лента Данные, группа Сортировка и фильтры, кнопка Сортировка
3. в открывшемся окне
4. в поле "Сортировать по" выбираете статус
5. в поле Порядок, выбираете Настраиваемый список
6. в открывшемся окне в поле Элементы списка пишете оплачено
7. Ок
8. Ок
_________________________________
оплачено - в верхних строках таблицы
благодарностей не нужно
Спасибо, но это не совсем то, что мне нужно, это я делала, но это ручное действие, а я хочу довести таблицу до автоматизма.

В любом случае спасибо Вам за беспокойство  :)  
 
перед тем как делать все это включите макрорекордер
не забудьте вовремя выключить его
у вас готовый макрос для автоматизации
для полной автоматизации придумываете когда его запускать и это все
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
Код
Sub ПеренестиОплачено()
    Const opla = "оплачено"

    Dim tb As ListObject
    Set tb = ActiveSheet.ListObjects(1)
    
    Dim aFormulaIn As Variant
    Dim aFormulaOu As Variant
    aFormulaIn = tb.DataBodyRange.Formula
    ReDim aFormulaOu(1 To UBound(aFormulaIn, 1), 1 To UBound(aFormulaIn, 2))
    
    Dim aStatus As Variant
    aStatus = tb.ListColumns("статус").DataBodyRange.Value
    
    Dim flag As Long
    Dim flagstaff As Long
    Dim xx As Long
    Dim yin As Long
    Dim you As Long
    
    you = you + 1
    For xx = 1 To UBound(aFormulaIn, 2)
        aFormulaOu(you, xx) = aFormulaIn(1, xx)
    Next
    For flagstaff = -1 To 0
        For yin = 2 To UBound(aStatus, 1)
            flag = (aStatus(yin, 1) = opla)
            If flag = flagstaff Then
                you = you + 1
                aFormulaOu(you, 1) = you - 1
                For xx = 2 To UBound(aFormulaIn, 2)
                    aFormulaOu(you, xx) = aFormulaIn(yin, xx)
                Next
            End If
        Next
    Next
    
    Application.EnableEvents = False
    tb.DataBodyRange.Formula = aFormulaOu
    Application.EnableEvents = True
End Sub
Изменено: МатросНаЗебре - 20.05.2022 12:06:05 (Application.EnableEvents)
 
Для увеличения автоматизации ), вставьте код в модуль листа
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Columns("F:G")) Is Nothing Then
         ПеренестиОплачено
    End If
End Sub
 
Цитата
написал:
Код
    [URL=#]?[/URL]       1  2  3  4  5  6  7  8  9  10  11  12  13  14  15  16  17  18  19  20  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36  37  38  39  40  41      Sub   ПеренестиОплачено()          Const   opla =   "оплачено"             Dim   tb   As   ListObject          Set   tb = ActiveSheet.ListObjects(1)                   Dim   aFormulaIn   As   Variant          Dim   aFormulaOu   As   Variant          aFormulaIn = tb.DataBodyRange.Formula          ReDim   aFormulaOu(1   To   UBound(aFormulaIn, 1), 1   To   UBound(aFormulaIn, 2))                   Dim   aStatus   As   Variant          aStatus = tb.ListColumns(  "статус"  ).DataBodyRange.Value                   Dim   flag   As   Long          Dim   flagstaff   As   Long          Dim   xx   As   Long          Dim   yin   As   Long          Dim   you   As   Long                   you = you + 1          For   xx = 1   To   UBound(aFormulaIn, 2)              aFormulaOu(you, xx) = aFormulaIn(1, xx)          Next          For   flagstaff = -1   To   0              For   yin = 2   To   UBound(aStatus, 1)                  flag = (aStatus(yin, 1) = opla)                  If   flag = flagstaff   Then                      you = you + 1                      aFormulaOu(you, 1) = you - 1                      For   xx = 2   To   UBound(aFormulaIn, 2)                          aFormulaOu(you, xx) = aFormulaIn(yin, xx)                      Next                  End   If              Next          Next                   Application.EnableEvents =   False          tb.DataBodyRange.Formula = aFormulaOu          Application.EnableEvents =   True    End   Sub   
 
Боже мой, это невероятно, Вы мой спаситель.
Я бы до такого сама точно не дошла в ближайшее время :oops:

Надо бы более подробно изучить написание макросов.

Спасибо Вам огромное :)  
Страницы: 1
Наверх