Разбить строку на слова по нажатию первой кнопки, отсортировать список слов по нажатию второй - VBA
Формулировка задачи:
Разбить строку, введённую в первую ячейку первого столбца активного листа, на слова, и вывести их в ячейки первого столбца, начиная со второй. Словом считается любая последовательность букв и цифр. Слова разделяются знаками препинания и/или пробелами. Идущие подряд разделители считаются одним. Полученный список слов отсортировать по возрастанию во втором столбце, начиная со второй строки. Для процедуры разбиения использовать одну кнопку, для процедуры сортировки – вторую.
Решение задачи: «Разбить строку на слова по нажатию первой кнопки, отсортировать список слов по нажатию второй»
textual
Листинг программы
Option Explicit Const Ex = "Разбить строку, введённую в первую ячейку первого столбца активного листа, на слова, и вывести их в ячейки первого столбца, начиная со второй. Словом считается любая последовательность букв и цифр. Слова разделяются знаками препинания и/или пробелами. Идущие подряд разделители считаются одним. Полученный список слов отсортировать по возрастанию во втором столбце, начиная со второй строки. Для процедуры разбиения использовать одну кнопку, для процедуры сортировки – вторую" Dim f&, s$, j$(), v Sub Macro() Dim f& [a1] = Ex For Each v In ActiveSheet.Buttons: v.Delete: Next For f = 1 To 2 With ActiveSheet.Buttons.Add(100, 30 * f, 60, 20) .OnAction = "Макрос" & f .Caption = Choose(f, "Разбить", "Сортировать") End With Next End Sub Sub Макрос1() j = Split([a1]) look End Sub Sub Макрос2() If Join(j) = "" Then j = Split([a1]) qSortStr j, 0, UBound(j) look End Sub Public Sub qSortStr(List() As String, ByVal min As Long, ByVal max As Long) Dim i&, l&: Static s1$, s2$ i = min: l = max: s1 = List((i + l) \ 2) Do Until i > l: While List(i) < s1: i = i + 1: Wend: While List(l) > s1: l = l - 1: Wend If (i <= l) Then s2 = List(i): List(i) = List(l): List(l) = s2: i = i + 1: l = l - 1 Loop If min < l Then qSortStr List, min, l If i < max Then qSortStr List, i, max End Sub Private Sub look(): For f = 0 To UBound(j): Cells(f + 2, 1) = j(f): Next: End Sub