Разбить строку на слова по нажатию первой кнопки, отсортировать список слов по нажатию второй - 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

Оцени полезность:

7   голосов , оценка 3.857 из 5
Похожие ответы