Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Отсортировать группировки по количеству запросов - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Отсортировать группировки по количеству запросов (Иное/Other)
Отсортировать группировки по количеству запросов
RedDeni Дата: Понедельник, 18.06.2018, 15:56 | Сообщение № 1
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
Доброго времени суток всем!

Есть множество группировок, с запросами у каждого запроса есть частота, как можно массово отсортировать каждую группировку отдельно по убыванию включаю главную фразу группировки?

Буду премного благодарен, заранее всем спасибо за помощь.
К сообщению приложен файл: ____-3-.xlsx (72.7 Kb)
 
Ответить
СообщениеДоброго времени суток всем!

Есть множество группировок, с запросами у каждого запроса есть частота, как можно массово отсортировать каждую группировку отдельно по убыванию включаю главную фразу группировки?

Буду премного благодарен, заранее всем спасибо за помощь.

Автор - RedDeni
Дата добавления - 18.06.2018 в 15:56
abtextime Дата: Понедельник, 18.06.2018, 17:36 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 828
Репутация: 117 ±
Замечаний: 0% ±

Excel 2010
RedDeni, из Вашего поста и примера понятна только _общая идея_, что Вы хотите получить, но не конкретно какой результат Вы хотите видеть на выходе. Всё то же самое, только отсортированное (по числу запросов в группировке и то же самое внутри группировки? Обязательно ли на том же листе или можно на другом, чистом?

Кстати, нет ли возможности данные преобразовать в намного более операбельную плоскую структуру, т.е. Группировка - Запрос - Меры без всяких группировок?
 
Ответить
СообщениеRedDeni, из Вашего поста и примера понятна только _общая идея_, что Вы хотите получить, но не конкретно какой результат Вы хотите видеть на выходе. Всё то же самое, только отсортированное (по числу запросов в группировке и то же самое внутри группировки? Обязательно ли на том же листе или можно на другом, чистом?

Кстати, нет ли возможности данные преобразовать в намного более операбельную плоскую структуру, т.е. Группировка - Запрос - Меры без всяких группировок?

Автор - abtextime
Дата добавления - 18.06.2018 в 17:36
boa Дата: Понедельник, 18.06.2018, 18:02 | Сообщение № 3
Группа: Друзья
Ранг: Ветеран
Сообщений: 549
Репутация: 167 ±
Замечаний: 0% ±

365
RedDeni,
Если я правильно понял...

[vba]
Код
Sub MySort()
'  Description: сортирует строки внутри подгруппы

Dim fRow&, i&
Dim iRow&: iRow = 2
Dim Arr()
    Do While Cells(iRow, 1) <> ""
        iRow = iRow + 1
        fRow = iRow 'запоминаем строку начала массива
        ReDim Arr(1 To 4, 1 To 1)
        For i = 1 To 100    '100 - максимально допустимое количество значений в выгрузке
            ReDim Preserve Arr(1 To 4, 1 To i)
            Arr(1, i) = Cells(iRow, 1)
            'второй столбец пропускаем, ибо пустой
            Arr(3, i) = Cells(iRow, 3)
            Arr(4, i) = Cells(iRow, 4)
            iRow = iRow + 1 'увеличиваем просматриваемую строку
            'если следующая строка 1-го уровня группировки, то выходим из цикла for
            If Cells(iRow, 1).Rows.OutlineLevel = 1 Then Exit For
        Next
        'заносим отсортированные значение на место старых
        Cells(fRow, 1).Resize(UBound(Arr, 2), UBound(Arr, 1)) = SortedArray(TransposeArray(Arr), 4)    '4 - колонка по которой сортируем
    Loop
End Sub

Function TransposeArray(ByRef SourceArray() As Variant) As Variant
    ' Для двумерного массива Application.Transpose не работает, поэтому
    ' Пользовательская функция для транспонирования двумерного массива
    Dim X1&: X1 = LBound(SourceArray, 1)
    Dim X2&: X2 = UBound(SourceArray, 1)
    Dim Y1&: Y1 = LBound(SourceArray, 2)
    Dim Y2&: Y2 = UBound(SourceArray, 2)
    Dim TempArray As Variant, i&, j&
    ReDim TempArray(Y1 To Y2, X1 To X2)
    For i = X1 To X2
        For j = Y1 To Y2
            TempArray(j, i) = SourceArray(i, j)
        Next j
    Next i
    TransposeArray = TempArray
End Function

Function SortedArray(Massiv As Variant, SortColumn&)
'функция сортировки двумерного массива
Dim N&, i&, j&
Dim TmpMas1(1 To 4) As Variant
Dim TmpMas2(1 To 4) As Variant

On Error Resume Next
For i = 1 To UBound(Massiv) Step 1 'просматриваем все строки массива с верхней до нижней границы
    For j = 1 To 4
        TmpMas1(j) = Massiv(i, j)
    Next j
        For N = i To UBound(Massiv)   'просматриваем строки массива, начиная с той, значения которой храняться в TmpMas1
        If Massiv(N, SortColumn) > TmpMas1(SortColumn) Then    'если значение в массиве больше, чем в переменной то присваиваем TmpMas1 новые, большие значения. Ддля смены направления сортировки изменить знак
            For j = 1 To 4
                TmpMas1(j) = Massiv(N, j)
                TmpMas2(j) = Massiv(i, j)   'сохраняем в переменных старые значения строки массива
                Massiv(i, j) = TmpMas1(j)   'и присваиваем этой строке массива новые
                Massiv(N, j) = TmpMas2(j)   'a строке N присваиваем старые значения из строки i
            Next j
        End If
        Next N
Next i
SortedArray = Massiv
End Function
[/vba]
К сообщению приложен файл: -3-.xlsb (65.0 Kb)


 
Ответить
СообщениеRedDeni,
Если я правильно понял...

[vba]
Код
Sub MySort()
'  Description: сортирует строки внутри подгруппы

Dim fRow&, i&
Dim iRow&: iRow = 2
Dim Arr()
    Do While Cells(iRow, 1) <> ""
        iRow = iRow + 1
        fRow = iRow 'запоминаем строку начала массива
        ReDim Arr(1 To 4, 1 To 1)
        For i = 1 To 100    '100 - максимально допустимое количество значений в выгрузке
            ReDim Preserve Arr(1 To 4, 1 To i)
            Arr(1, i) = Cells(iRow, 1)
            'второй столбец пропускаем, ибо пустой
            Arr(3, i) = Cells(iRow, 3)
            Arr(4, i) = Cells(iRow, 4)
            iRow = iRow + 1 'увеличиваем просматриваемую строку
            'если следующая строка 1-го уровня группировки, то выходим из цикла for
            If Cells(iRow, 1).Rows.OutlineLevel = 1 Then Exit For
        Next
        'заносим отсортированные значение на место старых
        Cells(fRow, 1).Resize(UBound(Arr, 2), UBound(Arr, 1)) = SortedArray(TransposeArray(Arr), 4)    '4 - колонка по которой сортируем
    Loop
End Sub

Function TransposeArray(ByRef SourceArray() As Variant) As Variant
    ' Для двумерного массива Application.Transpose не работает, поэтому
    ' Пользовательская функция для транспонирования двумерного массива
    Dim X1&: X1 = LBound(SourceArray, 1)
    Dim X2&: X2 = UBound(SourceArray, 1)
    Dim Y1&: Y1 = LBound(SourceArray, 2)
    Dim Y2&: Y2 = UBound(SourceArray, 2)
    Dim TempArray As Variant, i&, j&
    ReDim TempArray(Y1 To Y2, X1 To X2)
    For i = X1 To X2
        For j = Y1 To Y2
            TempArray(j, i) = SourceArray(i, j)
        Next j
    Next i
    TransposeArray = TempArray
End Function

Function SortedArray(Massiv As Variant, SortColumn&)
'функция сортировки двумерного массива
Dim N&, i&, j&
Dim TmpMas1(1 To 4) As Variant
Dim TmpMas2(1 To 4) As Variant

On Error Resume Next
For i = 1 To UBound(Massiv) Step 1 'просматриваем все строки массива с верхней до нижней границы
    For j = 1 To 4
        TmpMas1(j) = Massiv(i, j)
    Next j
        For N = i To UBound(Massiv)   'просматриваем строки массива, начиная с той, значения которой храняться в TmpMas1
        If Massiv(N, SortColumn) > TmpMas1(SortColumn) Then    'если значение в массиве больше, чем в переменной то присваиваем TmpMas1 новые, большие значения. Ддля смены направления сортировки изменить знак
            For j = 1 To 4
                TmpMas1(j) = Massiv(N, j)
                TmpMas2(j) = Massiv(i, j)   'сохраняем в переменных старые значения строки массива
                Massiv(i, j) = TmpMas1(j)   'и присваиваем этой строке массива новые
                Massiv(N, j) = TmpMas2(j)   'a строке N присваиваем старые значения из строки i
            Next j
        End If
        Next N
Next i
SortedArray = Massiv
End Function
[/vba]

Автор - boa
Дата добавления - 18.06.2018 в 18:02
RedDeni Дата: Вторник, 19.06.2018, 06:55 | Сообщение № 4
Группа: Пользователи
Ранг: Прохожий
Сообщений: 2
Репутация: 0 ±
Замечаний: 0% ±

Excel 2016
abtextime, В принципе не важно как это будет выглядеть, сами группировки(или не не группировки, просто уже имеется выгрузка из кластеризатора) можно отсортировать по количеству фраз в них, а фразы внутри группировок должно отсортированы от наиболее частотных к низко частотным.
 
Ответить
Сообщениеabtextime, В принципе не важно как это будет выглядеть, сами группировки(или не не группировки, просто уже имеется выгрузка из кластеризатора) можно отсортировать по количеству фраз в них, а фразы внутри группировок должно отсортированы от наиболее частотных к низко частотным.

Автор - RedDeni
Дата добавления - 19.06.2018 в 06:55
abtextime Дата: Вторник, 19.06.2018, 11:09 | Сообщение № 5
Группа: Проверенные
Ранг: Ветеран
Сообщений: 828
Репутация: 117 ±
Замечаний: 0% ±

Excel 2010
RedDeni, если для Вас структура именно с группировками (плюсиками) не является священной коровой, то сделайте плоскую таблицу вида Группировка-Запрос-Частота и в сводной таблице - сортировки. Понимаете, о чем я? Плоская таблица - это самый удобный вид организации первичных данных.

Это разбиение по группировкам (плюсикам) у Вас сейчас как-то автоматизированно получается?
 
Ответить
СообщениеRedDeni, если для Вас структура именно с группировками (плюсиками) не является священной коровой, то сделайте плоскую таблицу вида Группировка-Запрос-Частота и в сводной таблице - сортировки. Понимаете, о чем я? Плоская таблица - это самый удобный вид организации первичных данных.

Это разбиение по группировкам (плюсикам) у Вас сейчас как-то автоматизированно получается?

Автор - abtextime
Дата добавления - 19.06.2018 в 11:09
boa Дата: Вторник, 19.06.2018, 15:48 | Сообщение № 6
Группа: Друзья
Ранг: Ветеран
Сообщений: 549
Репутация: 167 ±
Замечаний: 0% ±

365
RedDeni, сортировка внутри группы вам была дана в Сообщение № 3
а группы excel и сам сортирует (у меня excel2016 на других версиях не проверял), но что бы группы правильно сортировались в вашем файле надо изменить размещение итоговой строки в структуре группировки(см.влож.)

для удобства дописал еще один макросик и подредактировал прошлые(добавил универсальности)

[vba]
Код
Sub SortGroup() 'запускать с этого макроса
'сортировка групп
'' Written: 19.06.2018
Dim iRow&, lCol
    
    With ActiveSheet
        If .FilterMode Then .ShowAllData
        iRow = .Cells(.Rows.Count, 1).End(xlUp).Row             'последняя заполненная строка
        lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column   'последняя видимая колонка с данными
        If Not .AutoFilterMode Then .Range(.Cells(1, 1), .Cells(iRow, lCol)).AutoFilter 'включаем фильтр
        With .AutoFilter.Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("B1:B" & iRow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    Call SortSubGroup
End Sub

Sub SortSubGroup()
'  Description: сортирует строки внутри группы
'' Written: 18.06.2018
Dim fRow&, i&, j&
Dim iRow&: iRow = 2
Dim Arr()
Dim maxRow&, maxCol&, SortCol&
    With ActiveSheet
    maxRow = WorksheetFunction.Max(.Columns(2))              'максимальное количество значений в группе
    maxCol = .Cells(1, .Columns.Count).End(xlToLeft).Column   'последняя видимая колонка с данными
    SortCol = 4                    'колонка по которой сортируем строки в группе
        Do While .Cells(iRow, 1) <> ""
            iRow = iRow + 1
            fRow = iRow                    'запоминаем первую строку группы
            ReDim Arr(1 To maxCol, 1 To 1)
            For i = 1 To maxRow                             'цикл "по строкам"
                ReDim Preserve Arr(1 To maxCol, 1 To i)
                For j = 1 To maxCol                         'цикл "по колонкам"
                    Arr(j, i) = IIf(IsError(.Cells(iRow, j)), 0, .Cells(iRow, j))    ' есть сроки с ошибками, поэтому добавил бработку ошибок
                Next j
                iRow = iRow + 1                             'увеличиваем номер просматриваемой строки
                'если следующая строка 1-го уровня группировки, то выходим из цикла "по строкам"
                If .Cells(iRow, 1).Rows.OutlineLevel = 1 Then Exit For
            Next i
            'заносим отсортированные значение на место старых
            .Cells(fRow, 1).Resize(UBound(Arr, 2), UBound(Arr, 1)) = SortedArray(TransposeArray(Arr), SortCol)
        Loop
    End With
End Sub

Function TransposeArray(ByRef SourceArray() As Variant) As Variant
    ' Для двумерного массива Application.Transpose не работает, поэтому
    ' Пользовательская функция для транспонирования двумерного массива
    Dim X1&: X1 = LBound(SourceArray, 1)
    Dim X2&: X2 = UBound(SourceArray, 1)
    Dim Y1&: Y1 = LBound(SourceArray, 2)
    Dim Y2&: Y2 = UBound(SourceArray, 2)
    Dim TempArray As Variant, i&, j&
    ReDim TempArray(Y1 To Y2, X1 To X2)
    For i = X1 To X2
        For j = Y1 To Y2
            TempArray(j, i) = SourceArray(i, j)
        Next j
    Next i
    TransposeArray = TempArray
End Function

Function SortedArray(Massiv As Variant, SortColumn&)
'функция сортировки двумерного массива
Dim N&, i&, j&, C&, TmpMas1(), TmpMas2()
C = UBound(Massiv, 2)
ReDim TmpMas1(1 To C) As Variant
ReDim TmpMas2(1 To C) As Variant

On Error Resume Next
For i = 1 To UBound(Massiv) Step 1 'просматриваем все строки массива с верхней до нижней границы
    For j = 1 To C
        TmpMas1(j) = Massiv(i, j)
    Next j
        For N = i To UBound(Massiv)   'просматриваем строки массива, начиная с той, значения которой храняться в TmpMas1
        If Massiv(N, SortColumn) > TmpMas1(SortColumn) Then    'если значение в массиве больше, чем в переменной то присваиваем TmpMas1 новые, большие значения. Ддля смены направления сортировки изменить знак
            For j = 1 To C
                TmpMas1(j) = Massiv(N, j)
                TmpMas2(j) = Massiv(i, j)   'сохраняем в переменных старые значения строки массива
                Massiv(i, j) = TmpMas1(j)   'и присваиваем этой строке массива новые
                Massiv(N, j) = TmpMas2(j)   'a строке N присваиваем старые значения из строки i
            Next j
        End If
        Next N
Next i
SortedArray = Massiv
End Function
[/vba]
К сообщению приложен файл: 6728604.xlsb (70.3 Kb) · 5911691.jpg (53.9 Kb)




Сообщение отредактировал boa - Вторник, 19.06.2018, 16:01
 
Ответить
СообщениеRedDeni, сортировка внутри группы вам была дана в Сообщение № 3
а группы excel и сам сортирует (у меня excel2016 на других версиях не проверял), но что бы группы правильно сортировались в вашем файле надо изменить размещение итоговой строки в структуре группировки(см.влож.)

для удобства дописал еще один макросик и подредактировал прошлые(добавил универсальности)

[vba]
Код
Sub SortGroup() 'запускать с этого макроса
'сортировка групп
'' Written: 19.06.2018
Dim iRow&, lCol
    
    With ActiveSheet
        If .FilterMode Then .ShowAllData
        iRow = .Cells(.Rows.Count, 1).End(xlUp).Row             'последняя заполненная строка
        lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column   'последняя видимая колонка с данными
        If Not .AutoFilterMode Then .Range(.Cells(1, 1), .Cells(iRow, lCol)).AutoFilter 'включаем фильтр
        With .AutoFilter.Sort
            .SortFields.Clear
            .SortFields.Add Key:=Range("B1:B" & iRow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
    Call SortSubGroup
End Sub

Sub SortSubGroup()
'  Description: сортирует строки внутри группы
'' Written: 18.06.2018
Dim fRow&, i&, j&
Dim iRow&: iRow = 2
Dim Arr()
Dim maxRow&, maxCol&, SortCol&
    With ActiveSheet
    maxRow = WorksheetFunction.Max(.Columns(2))              'максимальное количество значений в группе
    maxCol = .Cells(1, .Columns.Count).End(xlToLeft).Column   'последняя видимая колонка с данными
    SortCol = 4                    'колонка по которой сортируем строки в группе
        Do While .Cells(iRow, 1) <> ""
            iRow = iRow + 1
            fRow = iRow                    'запоминаем первую строку группы
            ReDim Arr(1 To maxCol, 1 To 1)
            For i = 1 To maxRow                             'цикл "по строкам"
                ReDim Preserve Arr(1 To maxCol, 1 To i)
                For j = 1 To maxCol                         'цикл "по колонкам"
                    Arr(j, i) = IIf(IsError(.Cells(iRow, j)), 0, .Cells(iRow, j))    ' есть сроки с ошибками, поэтому добавил бработку ошибок
                Next j
                iRow = iRow + 1                             'увеличиваем номер просматриваемой строки
                'если следующая строка 1-го уровня группировки, то выходим из цикла "по строкам"
                If .Cells(iRow, 1).Rows.OutlineLevel = 1 Then Exit For
            Next i
            'заносим отсортированные значение на место старых
            .Cells(fRow, 1).Resize(UBound(Arr, 2), UBound(Arr, 1)) = SortedArray(TransposeArray(Arr), SortCol)
        Loop
    End With
End Sub

Function TransposeArray(ByRef SourceArray() As Variant) As Variant
    ' Для двумерного массива Application.Transpose не работает, поэтому
    ' Пользовательская функция для транспонирования двумерного массива
    Dim X1&: X1 = LBound(SourceArray, 1)
    Dim X2&: X2 = UBound(SourceArray, 1)
    Dim Y1&: Y1 = LBound(SourceArray, 2)
    Dim Y2&: Y2 = UBound(SourceArray, 2)
    Dim TempArray As Variant, i&, j&
    ReDim TempArray(Y1 To Y2, X1 To X2)
    For i = X1 To X2
        For j = Y1 To Y2
            TempArray(j, i) = SourceArray(i, j)
        Next j
    Next i
    TransposeArray = TempArray
End Function

Function SortedArray(Massiv As Variant, SortColumn&)
'функция сортировки двумерного массива
Dim N&, i&, j&, C&, TmpMas1(), TmpMas2()
C = UBound(Massiv, 2)
ReDim TmpMas1(1 To C) As Variant
ReDim TmpMas2(1 To C) As Variant

On Error Resume Next
For i = 1 To UBound(Massiv) Step 1 'просматриваем все строки массива с верхней до нижней границы
    For j = 1 To C
        TmpMas1(j) = Massiv(i, j)
    Next j
        For N = i To UBound(Massiv)   'просматриваем строки массива, начиная с той, значения которой храняться в TmpMas1
        If Massiv(N, SortColumn) > TmpMas1(SortColumn) Then    'если значение в массиве больше, чем в переменной то присваиваем TmpMas1 новые, большие значения. Ддля смены направления сортировки изменить знак
            For j = 1 To C
                TmpMas1(j) = Massiv(N, j)
                TmpMas2(j) = Massiv(i, j)   'сохраняем в переменных старые значения строки массива
                Massiv(i, j) = TmpMas1(j)   'и присваиваем этой строке массива новые
                Massiv(N, j) = TmpMas2(j)   'a строке N присваиваем старые значения из строки i
            Next j
        End If
        Next N
Next i
SortedArray = Massiv
End Function
[/vba]

Автор - boa
Дата добавления - 19.06.2018 в 15:48
Мир MS Excel » Вопросы и решения » Вопросы по Excel » Отсортировать группировки по количеству запросов (Иное/Other)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!