0

Таблица excel Имеется такая таблица excel. Необходимо отсортировать данные(белые поля) в случайном порядке в несвязанных строках.Как это можно сделать?

Имеется опыт сортировки при помощи

=CЛЧИС()

но как быть когда строки не связаны? Неужели придется перекопировать данные на отдельный лист, затем добавить столбец с

=СЛЧИС()

а затем как следует их сортирнуть? :]

Есть ли методы получше, чем этот сферический конь в вакууме?

Спасибо, камрады, за наставление на путь истинный!

1 ответ 1

1

Вариант решения без макросов, только используя формулы Excel, сортировку по нескольким столбцам и разделение листа Исходной таблицы на листы:

Данные - содержит данные с дополнительными столбцами, имеющими формулу, для сортировки;

Форму - отображает данных в требуемом формате случайным образом.

По шагам:

  1. Имеем лист Исходная таблица

1

  1. Создаем лист Данные, перед столбцами, которые необходимо сортировать в случайном порядке, вставляем новые столбцы с функциями СЛЧИСЛ().

2

На примере добавленные столбцы: Сл Наименование товара, Сл Параметр 2.

  1. Для сортировки по нескольким столбцам используем Данные / Сортировка. В примере столбцы: Сл Наименование товара, Сл Параметр 2.

Примечание: при выборе ОК произойдет сортировка и сразу же пересчет функции СЛЧИСЛ().

3

  1. Для отображения данных в требуемом формате создаем лист Форма.

4

  1. Для отображения значений в полях используем формулу для первой строки =ИНДЕКС(Данные!$A$1:$F$6;СТРОКА();3), которая ссылается на вторую строку третьего столбца листа Данные. Для корректного отображения третьей и следующих строк формула с учетом смещения строк - =ИНДЕКС(Данные!$A$1:$F$6;СТРОКА()/2+1;3)

5

  1. Все это работает следующим образом: функция СЛЧИСЛ() ячейкам присваивает случайное значение, при применении Сортировки на листе Данные происходит изменение порядка значений в ячейках, результат сортировки по ссылкам отображается на листе Форма.

  2. При необходимости ячейки с листа Форма копируются и значения вставляются на другой лист.

Вариант решения с использованием макросов. Основная идея: значения ячеек необходимые для сортировки копируем в исходный массив, который сортируется случайным образом (получаем результирующий массив) и далее записываем в ячейки таблицы.

По шагам:

  1. Код макроса

    Option Explicit '  включаем явное объявления всех переменных
    Option Base 1   ' объявляем нижнюю границу по умолчанию для индексов массивов
    ' основная идея: значения ячеек необходимые для сортировки копируем в исходный массив,
    ' который сортируется случайным образом (получаем результирующий массив) и далее
    ' записываем в ячейки таблицы
    Sub RandomOrderTable()
    Dim sSrtblClmn As String    ' строка содержащая номер столбцов, в которых будет производиться сортировка ячеек
    Dim aSrtblClmn() As String  ' массив для хранения номеров столбцов, в которых будет производится сортировка ячеек
    Dim aRw() As Variant        ' исходный массив со значениями ячеек таблицы
    Dim aRndRw() As Variant     ' результирующий массив со значениями элементов aRw отсортированных случайным образом
    Dim i As Integer
    Dim k As Integer
    Dim l As Integer            ' индекс исходного массива (количества ячеек), который будет подвергнут сортировке
    Dim iLstRw As Integer       ' количество строк исходной таблицы
    Dim iClrIndx As Integer     ' значение индекса цвет заливки для строк не участвующих в сортировке
    
    iLstRw = Cells.SpecialCells(xlLastCell).Row     ' определили количесвто строк исходной таблицы
    
    sSrtblClmn = "2;4"
    aSrtblClmn = Split(sSrtblClmn, ";")
    
    iClrIndx = Cells(2, 1).Interior.ColorIndex      ' определили индекс цвета ячейки без заливки
    ' цикл перебора столбцов, которые будут копироваться в массив
    For i = LBound(aSrtblClmn) To UBound(aSrtblClmn)
        l = 1
        ' цикл перебора строк, которые будут копироваться в массив
        For k = 1 To iLstRw
            ' проверяем фон ячейки, если заливки нет, то копируем значение ячейки в исходный массив
            If Cells(k, Int(aSrtblClmn(i))).Interior.ColorIndex = iClrIndx Then
                ' переопределяем массив и заносим значение ячейки в массив
                ReDim Preserve aRw(l)
                aRw(l) = Cells(k, Int(aSrtblClmn(i))).Value
                l = l + 1
            End If
        Next k
        ' сортируем массив случайным образом и сохраняем результат в результирующем массиве
        aRndRw = SortRndArray(aRw)
    
        l = 1
        ' записываем значения результирующего массива в ячейки
        For k = 1 To iLstRw
            If Cells(k, Int(aSrtblClmn(i))).Interior.ColorIndex = iClrIndx Then
                Cells(k, Int(aSrtblClmn(i))).Value = aRndRw(l)
                l = l + 1
            End If
        Next k
    Next i
    End Sub
    
    ' функция случайной сортировки взята по ссылке http://hav.su/index.php?option=com_content&view=article&id=64:-2&catid=35:calc
    Function SortRndArray(A As Variant) As Variant
      'B - массив-результат
      Dim B As Variant
      'случайный индекс элемента массива
      Dim MyRndValue As Byte
      Dim i As Integer
      'Max_i - максимальное количество элементов
      Dim Max_i As Integer
      Max_i = UBound(A, 1)
      ReDim B(LBound(A, 1) To UBound(A, 1)) As Variant
      'заполнение выходного массива B
      'в произвольном порядке выбирая их из A
      For i = LBound(A, 1) To UBound(A, 1)
        'определение номера элемента из A
        MyRndValue = Int((Max_i * Rnd) + 1)
        'занесение этого элемента в выходной массив
        B(i) = A(MyRndValue)
        'замещение выбранного элемента из A последним элементом из A
        A(MyRndValue) = A(Max_i)
        'понижение верхней границы массива
        'т.о. "уменьшаем" размер массива на один элемент
        Max_i = Max_i - 1 
      Next i
      'возвращаем массив значений B
      SortRndArray = B
    End Function
    
  2. Копируем код макроса в таблицу Excel (Разработчик - Vsual Basic);

  3. Исходная таблица:

23

  1. Запускаем макрос (Alt+F8)

24

  1. Получаем результат:

25

Ваш ответ

By clicking “Отправить ответ”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Всё ещё ищете ответ? Посмотрите другие вопросы с метками или задайте свой вопрос.