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 you have read our privacy policy.

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