Наш с Алисой блог
Дневник жизни маленькой семьи
понедельник, 27 июля 2026 г.
Как стать счастливым?
понедельник, 19 мая 2025 г.
Про частоту слогов в русских словах
Sub SortTableValues()
Dim ws As Worksheet
Dim dataRange As Range
Dim cell As Range
Dim dataList() As Variant
Dim i As Long, j As Long, k As Long
Dim outputWs As Worksheet
Dim lastRow As Long
' Указываем лист с данными (измените при необходимости)
Set ws = ThisWorkbook.Sheets("Лист1") ' Замените на имя вашего листа
' Определяем диапазон данных (V1:AP11)
Set dataRange = ws.Range("V1:AP11")
' Создаем временный массив для хранения данных
ReDim dataList(1 To dataRange.Rows.Count * dataRange.Columns.Count, 1 To 2)
k = 1
' Заполняем массив данными в формате "Значение - Заголовок"
For i = 2 To dataRange.Rows.Count ' Начинаем со 2 строки (первая - заголовки)
For j = 2 To dataRange.Columns.Count ' Начинаем со 2 столбца (первый - заголовки)
If Not IsEmpty(dataRange.Cells(i, j).Value) Then
dataList(k, 1) = dataRange.Cells(i, j).Value ' Значение ячейки
dataList(k, 2) = dataRange.Cells(1, j).Value & " - " & dataRange.Cells(i, 1).Value ' Заголовки
k = k + 1
End If
Next j
Next i
' Сортируем массив по значениям (1 столбец)
Call QuickSort(dataList, 1, k - 1, 1)
' Создаем новый лист для вывода (или очищаем существующий)
On Error Resume Next
Set outputWs = ThisWorkbook.Sheets("Отсортированные данные")
If outputWs Is Nothing Then
Set outputWs = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
outputWs.Name = "Отсортированные данные"
Else
outputWs.Cells.Clear
End If
On Error GoTo 0
' Записываем заголовки
outputWs.Range("A1").Value = "№"
outputWs.Range("B1").Value = "Элемент"
outputWs.Range("C1").Value = "Значение"
' Выводим первые 200 значений (или меньше, если данных недостаточно)
For i = 1 To Application.Min(200, k - 1)
outputWs.Cells(i + 1, 1).Value = i
outputWs.Cells(i + 1, 2).Value = dataList(i, 2)
outputWs.Cells(i + 1, 3).Value = dataList(i, 1)
Next i
' Форматируем вывод
outputWs.Columns("A:C").AutoFit
outputWs.Range("A1:C1").Font.Bold = True
MsgBox "Готово! Отсортированные данные сохранены на листе '" & outputWs.Name & "'.", vbInformation
End Sub
' Быстрая сортировка (QuickSort) для двумерного массива
Sub QuickSort(arr, ByVal first As Long, ByVal last As Long, ByVal col As Long)
Dim i As Long, j As Long
Dim pivot As Variant, temp As Variant
i = first
j = last
pivot = arr((first + last) \ 2, col)
Do While i <= j
Do While arr(i, col) < pivot And i < last
i = i + 1
Loop
Do While arr(j, col) > pivot And j > first
j = j - 1
Loop
If i <= j Then
' Меняем местами обе части массива
temp = arr(i, 1)
arr(i, 1) = arr(j, 1)
arr(j, 1) = temp
temp = arr(i, 2)
arr(i, 2) = arr(j, 2)
arr(j, 2) = temp
i = i + 1
j = j - 1
End If
Loop
If first < j Then QuickSort arr, first, j, col
If i < last Then QuickSort arr, i, last, col
End SubКак использовать:
Откройте Excel и нажмите
Alt + F11, чтобы открыть редактор VBA.Вставьте этот код в новый модуль (
Insert→Module).Запустите макрос (
F5или через менюRun).Результат появится на новом листе "Отсортированные данные" в формате:
Столбец A: Порядковый номер
Столбец B: "Заголовок столбца - Заголовок строки"
Столбец C: Значение ячейки
Примечания:
Макрос берет данные из диапазона V1:AP11.
Если значений меньше 200, выведет все доступные.
Пустые ячейки игнорируются.
Нужно что-то изменить под ваши задачи? 😊
пятница, 14 февраля 2025 г.
Смотрю видео на ютюбе
Да, кстати он сейчас без нпн не грузится совсем, вот так живем.
Сначала плпалась восхитительная аудиокнига Часы Тургеньева, прелестное произведение. Сейчас слушаю интервью из серии ЖЗЛ и просто хочу запомнить фразу: прозрачный по красоте душевной человек.
Какая красивая фраза.
Всем света и добра.





