Создайте макрос в excel который выделенный диапазон ячеек одной строки a1 h1 сортирует по убыванию - Word и Excel

EvaAleks

Пользователь

Сообщений: 28
Регистрация: 14.10.2015

Добрый день.
В прилагаемом файле кусочек сортируемых данных и текст моего макроса.
Задача: данные в таблице отсортировать по колонке С по убыванию.
Вопрос: что поменять в макросе чтобы макрос сортировал по третьей колонке, а не по первой? Он сортирует названия городов.
При автоматической записи не получилось избавиться от уже выделенного диапазона.

Прикрепленные файлы

Пример.xlsx (10.03 КБ)

Kuzmich

Пользователь

Сообщений: 7998
Регистрация: 21.12.2012

08.09.2021 17:56:46

Код
Sub iSort_3() Dim iLastRow As Long iLastRow = Cells(Rows.Count, "C").End(xlUp).Row Range("A1:C" & iLastRow).Sort Range("C1"), xlDescending, Header:=xlYes End Sub

EvaAleks

Пользователь

Сообщений: 28
Регистрация: 14.10.2015

08.09.2021 22:34:05

Не могу понять ((
На трех столбцах работает. А когда пытаюсь применить на другом диапазоне, с другим количеством колонок получается фигня — сортирует все вместе и за пределами выделенного диапазона.

В Пример2 нужно сортировать по желтой колонке 3 разных диапазона (выделила их рамкой и цветом).
Что неправильно?

Код
Sub iSort_3() Dim iLastRow As Long iLastRow = Cells(Rows.Count, "F").End(xlUp).Row Range("B1:F" & iLastRow).Sort Range("F1"), xlDescending, Header:=xlYes End Sub

Прикрепленные файлы

Пример2.xlsx (15.95 КБ)

Изменено: vikttur — 09.09.2021 00:27:01

Kuzmich

Пользователь

Сообщений: 7998
Регистрация: 21.12.2012

08.09.2021 22:50:20

EvaAleks,

Код
iLastRow = Cells(Rows.Count, "F").End(xlUp).Row

Эта команда ищет последнюю строку в столбце F (=82)
Поэтому и сортирует B1:F82

New Пользователь Сообщений: 4582 Регистрация: 06.01.2013

EvaAleks Пользователь Сообщений: 28 Регистрация: 14.10.2015	Kuzmich, что исправить чтобы сортировал только выделенный диапазон? И потом при выделении другого диапазона так же не трогал другие области? Изменено: EvaAleks — 09.09.2021 09:03:58

Дмитрий(The_Prist) Щербаков

Пользователь

Сообщений: 14182
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

09.09.2021 09:15:53

Цитата
EvaAleks написал: только выделенный диапазон

видимо, как-то так:

Код
Sub iSort_3() If Selection.Columns.Count >= 3 Then Selection.Sort Selection.Cells(1, 3), xlDescending, Header:=xlYes End If End Sub

Изменено: Дмитрий(The_Prist) Щербаков — 09.09.2021 09:17:37
(добавил проверку на кол-во столбцов)

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

EvaAleks Пользователь Сообщений: 28 Регистрация: 14.10.2015	Дмитрий(The_Prist) Щербаков, вообще не ясно что он сортирует. Цифры в желтой колонке не по убыванию. И захватываются данные по всем диапазону B:F

Дмитрий(The_Prist) Щербаков

Пользователь

Сообщений: 14182
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

09.09.2021 09:56:38

Цитата
EvaAleks написал: вообще не ясно что он сортирует

вообще не ясно что Вы выделяете и что в колонках B:F. Вы вроде как просили:

Цитата
EvaAleks написал: чтобы сортировал только выделенный диапазон

код именно это и делает: сортирует только выделенный диапазон и только по третьему столбцу. Может надо что-то другое и Вы забыли нам об этом сообщить?

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

EvaAleks,
сформулируйте задачу, тогда, возможно, вам подскажут как или чем ее решить
(в мире написано миллиарды отличных макросов, но «заточены» они для решения возможно очень похожих, но других задач)

Программисты — это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!

EvaAleks

Пользователь

Сообщений: 28
Регистрация: 14.10.2015

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

В файле Пример2 часть этой таблицы из трех диапазонов и меньшим числом колонок. Каждый диапазон (в файле я выделила жирной рамкой и тремя разными цветами) я выделяю вручную, т.к. количество строк разное. В Примере я выделяю сначала диапазон B3:F28 и сортирую по колонке F; затем выделяю диапазон B30:F55 и опять сортирую по колонке F; выделяю диапазон B57:F82 и опять сортирую по колонке F.

А макрос сортирует в рамках B1:F82. Это не правильно в моем случае.

Дмитрий(The_Prist) Щербаков

Пользователь

Сообщений: 14182
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

#12

09.09.2021 10:27:20

Цитата
EvaAleks написал: А макрос сортирует в рамках B1:F82

какой именно? Почему я в Вашем файле выделяю диапазон А1:С17 -запускаю свой макрос и он сортирует мне только диапазон А1:С17? Т.е. именно(и только!) тот, который я выделил до запуска кода.

Цитата
EvaAleks написал: опять сортирую по колонке F

а колонка F в диапазоне B1:F82 никак не 3-я по счету. Определитесь с критериями и с задачей в целом.

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

EvaAleks

Пользователь

Сообщений: 28
Регистрация: 14.10.2015

Дмитрий(The_Prist) Щербаков, у меня приложено 2 файла. В первом —

Пример.xlsx

только один диапазон и 3 колонки. Ниже

в посте

я выложила другой файл —

Пример2.xlsx

. В первом случае макрос работает, во втором случае нет. Поэтому и спросила как исправить макрос, чтобы он работал на другом количестве колонок и при выделении диапазонов ниже.

RAN

Пользователь

Сообщений: 7091
Регистрация: 21.12.2012

#14

09.09.2021 11:00:10

Вангую.

Код
Sub Vanga() Selection.Sort Selection.Cells(1, Selection.Columns.Count), xlDescending, Header:=xlNo End Sub

Дмитрий(The_Prist) Щербаков

Пользователь

Сообщений: 14182
Регистрация: 15.09.2012

Профессиональная разработка приложений для MS Office

#15

09.09.2021 11:00:33

Цитата
EvaAleks написал: В первом случае макрос работает, во втором случае нет.

и опять не верно. Напишите подробнее что делаете и что ожидаете в итоге. Только что проверил на втором файле — выделил диапазон B3:F28, запустил свой код — диапазон отсортировался по столбцу D, как и было в изначальной задаче(т.е. третий столбец выделенного диапазона). Выделил B30:F55 — запустил — тоже отсортировался только выделенный диапазон и только по третьему столбцу выделенного диапазона.
Сортирует по убыванию, т.к. не совсем понятно как именно надо.

Цитата
EvaAleks написал: он работал на другом количестве колонок

где Вы это написали и где указали, как это должно работать? Выделили Вы диапазон A1:CD3219 — по какой должен сортировать макрос? Вы написали только это:

Цитата
EvaAleks написал: сортировка по убыванию по определенной колонке

неплохо бы еще и указать, как понять какая это колонка. Как определить ту, по которой сортировать? Действительно ли она всегда последняя, как попробовали угадать в сообщении выше?
чем четче Вы опишите задачу — тем быстрее и правильнее будет полученный ответ.

Цитата
Дмитрий(The_Prist) Щербаков написал: Вангую

ох, неблагодарное это занятие Но похоже на правду. Но тут же важно понимать, нужны ли заголовки, реально ли именно по последнему выделенному столбцу надо сортировать…А нам об этом не сильно-то рассказывают.

Изменено: Дмитрий(The_Prist) Щербаков — 09.09.2021 11:10:04

Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы…

RAN

Пользователь

Сообщений: 7091
Регистрация: 21.12.2012

#16

09.09.2021 11:16:57

Или даже так

Код
Sub Vanga_2() Dim x& With Selection x = InputBox("Укажите № столбца в выделении", , .Columns.Count) .Sort .Cells(1, x), xlDescending, Header:=xlNo End With End Sub

EvaAleks Пользователь Сообщений: 28 Регистрация: 14.10.2015	RAN, заработало!!!! ))) только каждый раз спрашивает по какому столбцу сортировать

RAN Пользователь Сообщений: 7091 Регистрация: 21.12.2012	Sub Vanga() не спрашивает.

EvaAleks Пользователь Сообщений: 28 Регистрация: 14.10.2015	RAN, а если понадобится отсортировать через Vanga допустим по 11 колонке, он сработает?

Неопытный_Экселист

Пользователь

Сообщений: 178
Регистрация: 25.06.2021

#20

09.09.2021 12:54:40

Цитата
EvaAleks написал: а если понадобится отсортировать через Vanga допустим по 11 колонке

А что мешает использовать два макроса: Vanga для просто сортировки и Vanga_2, если надо отсортировать по конкретному столбцу (например по 11-му)?

EvaAleks Пользователь Сообщений: 28 Регистрация: 14.10.2015	Просто каждый раз указывать номер нужной колонки?

EvaAleks,
Да. А как по-другому? Если сортируем всегда по одному столбцу, то программе достаточно указать его один раз, и дальше она сама всё будет делать. А вот если каждый раз столбец, по которому сортируем, разный — как программа должна узнать, какой столбец в конкретный момент её выполнения ей нужно использовать? Только, если ей каждый раз его принудительно указывать.

EvaAleks Пользователь Сообщений: 28 Регистрация: 14.10.2015	#23 09.09.2021 13:05:57 Просто уточняю, правильно лия поняла ))) Спасибо огромное. Слишком много времени прошло с того момента как я записывала и редактировала макросы. А сейчас уже не соображаю, где косячу.

Источник

Сортировка данных в таблице на рабочем листе Excel средствами VBA. Sort и SortField, объекты и методы. Примеры сортировки данных в диапазоне.

Синтаксис сортировки

Синтаксис полного кода VBA Excel, применяемого для сортировки данных в таблицах и диапазонах:

With Expression.Sort

.SortFields.Clear

.SortFields.Add Key, SortOn, Order, DataOption

.SetRange [Range]

.Header = [xlGuess, xlYes, xlNo]

.MatchCase = [True, False]

.Orientation = [xlTopToBottom, xlLeftToRight]

.Apply

End With

Синтаксис сокращенного кода VBA Excel, применяемого для сортировки данных с параметрами по умолчанию:

With Expression.Sort

.SortFields.Clear

.SortFields.Add Key

.SetRange [Range]

.Apply

End With

Expression – выражение, возвращающее объект Worksheet, например:

ActiveSheet

Worksheets («Лист1»)

ActiveWorkbook.Worksheets («Лист1»)

Workbooks(«Книга1.xlsm»).Worksheets («Лист1»)

Расшифровка кода

1. Expression.Sort – метод Sort объекта Worksheet возвращает объект Sort.

Объект Sort – это объект, представляющий сортировку диапазона данных.

2. .SortFields.Clear – метод SortFields объекта Sort возвращает коллекцию объектов SortFields. Метод Clear объекта SortFields удаляет все существующие объекты SortField.

Объект SortField содержит все сведения о параметрах сортировки для заданного рабочего листа.

3. .SortFields.Add Key, SortOn, Order, DataOption – метод Add объекта SortFields создает и возвращает новый экземпляр объекта SortField с заданными параметрами.

Параметры метода Add объекта SortFields:

Key – обязательный параметр, который задает значение ключа для сортировки. Тип данных – Range. Обычно указывается первая ячейка столбца при сортировке по строкам или первая ячейка строки при сортировке по столбцам. Сортировка диапазона будет осуществлена по данным столбца (строки), первая ячейка которого указана в качестве ключа.

SortOn – необязательный параметр, который задает критерий сортировки (по какому свойству ячеек производится сортировка).

Значения, которые может принимать SortOn:

Константа	Значение	Описание
SortOnValues	0	сортировка по значению (значение по умолчанию)
SortOnCellColor	1	сортировка по цвету ячейки
SortOnFontColor	2	сортировка по цвету шрифта
SortOnIcon	3	сортировка по иконке*

* Иконки (значки) могут быть заданы ячейкам при условном форматировании диапазона.

Order – необязательный параметр, задающий порядок сортировки (по возрастанию или по убыванию).

Значения, которые может принимать Order:

Константа	Значение	Описание
xlAscending	1	сортировка по возрастанию (значение по умолчанию)
xlDescending	2	сортировка по убыванию

DataOption – необязательный параметр, который задает способ сортировки текста.

Значения, которые может принимать DataOption:

Константа	Значение	Описание
xlSortNormal	0	числовые и текстовые данные сортируются отдельно (значение по умолчанию)
xlSortTextAsNumbers	1	текстовые данные рассматриваются для сортировки как числовые

4. .SetRange [Range] – метод SetRange объекта Sort задает диапазон (таблицу), в котором выполняется сортировка.

5. .Header = [xlGuess, xlYes, xlNo] – свойство Header объекта Sort указывает, является ли первая строка таблицы строкой заголовков (шапкой).

Значения, которые может принимать свойство Header:

Константа	Значение	Описание
xlGuess	0	Excel сам определяет, есть ли строка заголовков
xlYes	1	строка заголовков есть, сортировка ее не затрагивает
xlNo	2	строки заголовков нет (значение по умолчанию)

6. .MatchCase = [True, False] – свойство MatchCase объекта Sort указывает, как учитывать регистр при сортировке.

Значения, которые может принимать свойство MatchCase:

Константа	Значение	Описание
False	0	регистр не учитывается (значение по умолчанию)
True	1	сортировка с учетом регистра

7. .Orientation = [xlTopToBottom, xlLeftToRight] – свойство Orientation объекта Sort задает ориентацию для сортировки.

Значения, которые может принимать свойство Orientation:

Константа	Значение	Описание
xlTopToBottom	1	сортировка по стокам (значение по умолчанию)
xlLeftToRight	2	сортировка по столбцам

8. .Apply – метод Apply объекта Sort выполняет сортировку диапазона в соответствии с примененными параметрами.

Примеры сортировки

Таблица для примеров

Сортировка по одному столбцу

Краткая запись кода VBA Excel для сортировки диапазона по первому столбцу с параметрами по умолчанию:

Sub Primer1()

With ActiveSheet.Sort

.SortFields.Clear

.SortFields.Add Key:=Range(«A2»)

.SetRange Range(«A2:C7»)

.Apply

End With

End Sub

Полная запись, но тоже с параметрами по умолчанию:

Sub Primer2()

With ActiveSheet.Sort

.SortFields.Clear

.SortFields.Add Key:=Range(«A2»), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

.SetRange Range(«A2:C7»)

.Header = xlNo

.MatchCase = False

.Orientation = xlTopToBottom

.Apply

End With

End Sub

Результат сортировки:

Сортировка по двум столбцам

Код VBA Excel для сортировки исходной таблицы по первому и второму столбцам с параметрами по умолчанию:

Sub Primer3()

With ActiveSheet.Sort

.SortFields.Clear

.SortFields.Add Key:=Range(«A2»)

.SortFields.Add Key:=Range(«B2»)

.SetRange Range(«A2:C7»)

.Apply

End With

End Sub

Результат сортировки:

Применение сортировки ко второму столбцу (добавление еще одного объекта SortField) не нарушает сортировку первого – в первом столбце меняются местами только ячейки с одинаковыми значениями.

Источник

сортировка выделенного диапазона макросом

Flatcher

Дата: Воскресенье, 21.02.2016, 20:06 |
Сообщение № 1

Группа: Проверенные

Ранг: Участник

Сообщений: 92

Репутация:
1
±

Замечаний:
0% ±

Excel 2010

Подскажите пожалуйста как организовать сортировку выделенного диапазона макросом? В коде постарался максимально расписать все

К сообщению приложен файл:

report.xls
(49.5 Kb)

Ответить

Апострофф

Дата: Воскресенье, 21.02.2016, 20:55 |
Сообщение № 2

Группа: Проверенные

Ранг: Обитатель

Сообщений: 416

Репутация:
117
±

Замечаний:
0% ±

Excel 1997

С минимальным отклонением от стиля и если я угадал поля сортировки —

[vba]

Код

Sub СОРТИРОВКА()
Dim rn As Range
Dim vAdr1 As String
Dim vAdr2 As String
‘ НА ВСЯКИЙ СЛУЧАЙ АКТИВИРУЕМ ПЕРВУЮ ЯЧЕЙКУ
Cells(1, 1).Select
‘ НАХОДИМ ПЕРВУЮ ЯЧЕЙКУ СО СЛОВОМ ОПЕРАЦИЯ
Cells.Find(What:=»Операция», After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Select
‘ ЗАПИСЫВАЕМ АДРЕС НАЙДЕННОЙ ЯЧЕЙКИ В ПЕРЕМЕННУЮ
vAdr1 = Selection.Address
‘ ВЫДЕЛЯЕМ СТОЛБЕЦ С ЗНАЧЕНИЯМИ ОТ НАЙДЕННОЙ ЯЧЕЙКИ ВНИЗ
Range(Selection, Selection.End(xlDown)).Select
‘ И ВЛЕВО
Range(Selection, Selection.End(xlToLeft)).Select
‘ ПРИМЕНЯЕМ СОРТИРОВКУ
Set rn = Selection
rn.Columns(1).NumberFormat = «dd.mm.yyyy»
rn.Columns(1).Value = rn.Columns(1).Value
rn.Columns(2).NumberFormat = «hh:mm:ss»
rn.Columns(2).Value = rn.Columns(2).Value
    rn.Sort Key1:=[a1], Order1:=xlAscending, Key2:= _
        [b1], Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers, _
        DataOption2:=xlSortTextAsNumbers

‘??????

‘ СМЕЩАЕМСЯ НА ОДНУ СТРОКУ ВНИЗ ДЛЯ ПРОДОЛЖЕНИЯ ПОИСКА
ActiveCell.Offset(1, 0).Select
‘ ЦИКЛ
Do
‘ ПРОДОЛЖАЕМ ПОИСК ДАЛЕЕ
Cells.FindNext(After:=ActiveCell).Select
‘ ЗАПИСЫВАЕМ АДРЕС НАЙДЕННОЙ ЯЧЕЙКИ В ПЕРЕМЕННУЮ
vAdr2 = Selection.Address
‘ СРАВНИВАЕМ ПЕРЕМЕННЫЕ (ЕСЛИ СОВПАДАЮТ С АДРЕСОМ ПЕРВОЙ НАЙДЕННОЙ ЯЧЕЙКИ ОСТАНАВЛИВАЕМ ЦИКЛ)
If Not vAdr1 <> vAdr2 Then Exit Do
‘ ВЫДЕЛЯЕМ СТОЛБЕЦ С ЗНАЧЕНИЯМИ ОТ НАЙДЕННОЙ ЯЧЕЙКИ ВНИЗ
Range(Selection, Selection.End(xlDown)).Select
‘ И ВЛЕВО
Range(Selection, Selection.End(xlToLeft)).Select
‘ ПРИМЕНЯЕМ СОРТИРОВКУ
Set rn = Selection
rn.Columns(1).NumberFormat = «dd.mm.yyyy»
rn.Columns(1).Value = rn.Columns(1).Value
rn.Columns(2).NumberFormat = «hh:mm:ss»
rn.Columns(2).Value = rn.Columns(2).Value
    rn.Sort Key1:=[a1], Order1:=xlAscending, Key2:= _
        [b1], Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortTextAsNumbers, _
        DataOption2:=xlSortTextAsNumbers

‘??????

‘ СМЕЩАЕМСЯ НА ОДНУ СТРОКУ ВНИЗ ДЛЯ ПРОДОЛЖЕНИЯ ПОИСКА
ActiveCell.Offset(1, 0).Select
Loop
End Sub

[/vba]

Ответить

nilem

Дата: Воскресенье, 21.02.2016, 20:55 |
Сообщение № 3

Группа: Авторы

Ранг: Старожил

Сообщений: 1612

Репутация:
563
±

Замечаний:
0% ±

Excel 2013, 2016

попробуйте так:
[vba]

Код

Sub СОРТИРОВКА()
Dim r As Range, adr$
Set r = Sheets(«Report»).UsedRange.Find(«Операция», LookIn:=xlValues, lookat:=xlWhole)
If Not r Is Nothing Then
    adr = r.Address
    Do
        With r.CurrentRegion
            With .Resize(.Rows.Count — 1)
                .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, _
                      Key2:=.Cells(1, 2), Order2:=xlAscending, Header:=xlYes
            End With
        End With
        Set r = Sheets(«Report»).UsedRange.FindNext(r)
    Loop While r.Address <> adr
End If
End Sub

[/vba]

Яндекс.Деньги 4100159601573

Ответить

Flatcher

Дата: Воскресенье, 21.02.2016, 21:11 |
Сообщение № 4

Группа: Проверенные

Ранг: Участник

Сообщений: 92

Репутация:
1
±

Замечаний:
0% ±

Excel 2010

Апострофф, спасибо работает))

Ответить

Flatcher

Дата: Воскресенье, 21.02.2016, 21:12 |
Сообщение № 5

Группа: Проверенные

Ранг: Участник

Сообщений: 92

Репутация:
1
±

Замечаний:
0% ±

Excel 2010

nilem, спасибо! тоже все заработало! насколько можно оказывается сокращать код)))

Ответить

Источник

This Excel macro sorts data that has headers in descending order. This means that data is sorted Z to A and 10 to 1 — or reverse alphabetical order and highest to lowest. This macro also assumes that there is one row of headers at the top of your data set or data range. If you have more than one row of headers on your data, simply make the range reference to the entire table start one row below the top header row — this will take into account two rows for headers.

This is a great and simple sorting macro in Excel and will help to get you started or will fit nicely into existing macros that you have.

To use this macro, simply replace A1:C56 with the range reference of your entire data set or data table that you want to be sorted and then replace A1 with the cell reference of the row that you would like to sort the rest of the data by in descending order.

Where to install the macro: Module

Excel Macro to Sort Data With Headers in Descending Order

Sub Sort_Descending_Basic_With_Header()
'Sorts a worksheet in descending order and assumes there are headers on the data

Range("A1:C56").Sort Key1:=Range("A1"), Order1:=xlDescending, Header:=xlYes

End Sub

Excel VBA Course — From Beginner to Expert

200+ Video Lessons
50+ Hours of Instruction
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

Сортировка столбца по убыванию

02.01.2015, 12:19. Показов 7733. Ответов 13

Метки нет (Все метки)

Наверняка платиновый вопрос и если покопаюсь по форуму, то найду, но все же создам отдельную тему, ибо голова болит. Суть — есть один жадный алгоритм Хаффмана и столбец из 50 элементов, который содержит вероятности появления символов. Соответственно должна получится треугольная таблица из 50 столбцов, в последнем из которых одна строка равная единице. Но это все лирика. Вот, что я написал

Visual Basic

Sub list1()
 x = 50
 For i = 1 To 50
  For j = 1 To x - 2
   Cells(i, j) = Cells(i + 1, j)
  Next
  Cells(i + 1, x - 1) = Cells(i, x) + Cells(i, x - 1)
  
  
  
End Sub

Соответственно мне еще необходимо отсортировать следующий столбец по убыванию. Быстрый поиск по гуглу ничего особого не дал, поэтому и спрашиваю, уж простите. Бонусный вопрос — есть ли возможность в Экселе как-то графически соеденить ячейки ПРОГРАММНО (то есть не просто вручную нарисовать линию)?

~~Night Ranger~~

Заблокирован

02.01.2015, 13:47

Сообщение было отмечено Spectator7675 как решение

Решение

Visual Basic

Sub www()
    Randomize
    With ActiveSheet
        If MsgBox("Создать колонку со своими числами ?", vbInformation Or vbYesNo) = vbNo Then Exit Sub
        .[a:a].Insert
        For i = 1 To 20: .Cells(i, 1) = Int(Rnd * 100): Next
        If MsgBox("Отсортировать по убыванию ?", vbInformation Or vbYesNo) = vbNo Then Exit Sub
        .[a:a].Sort .[a1], xlDescending
        If MsgBox("Готово! Убрать новую колонку?", vbInformation Or vbYesNo) = vbNo Then Exit Sub
        .[a:a].Delete
    End With
End Sub

Добавлено через 17 минут
Можно еще так:

Visual Basic

Sub SortA()
    With ActiveSheet
        If MsgBox("Создать колонку со своими числами ?", vbInformation Or vbYesNo) = vbNo Then Exit Sub
        .[a:a].Insert: Randomize
        For i = 1 To 20: .Cells(i, 1) = Int(Rnd * 100): Next
        Select Case MsgBox("Отсортировать ??? по возрастанию(да)/по убыванию(нет)", vbInformation Or vbYesNoCancel)
        Case vbYes: .[a:a].Sort .[a1], xlAscending
        Case vbNo: .[a:a].Sort .[a1], xlDescending
        Case Else: Exit Sub
        End Select
        If MsgBox("Готово! Убрать новую колонку?", vbInformation Or vbYesNo) = vbNo Then Exit Sub
        .[a:a].Delete
    End With
End Sub

0 / 0 / 0

Регистрация: 02.01.2015

Сообщений: 7

02.01.2015, 14:14

[ТС]

Спасибо, я примерно понял, осталось доразобраться как работает функция .sort, ну с этим я расправлюсь как окончательно проснусь. И все же, никак ячейки в экселе программно не связать стрелочками? Мне же эту таблицу потом разматывать в обратном направлении.

~~Night Ranger~~

Заблокирован

02.01.2015, 16:08

Сообщение было отмечено Spectator7675 как решение

Решение

вот:

Visual Basic

'Option Explicit
 
Sub Connector()
    Const icn = "iConnector"
    With ActiveSheet
        If MsgBox("Создать новую колонку ?", vbInformation Or vbYesNo) = vbNo Then Exit Sub
         .[a:a].Insert: ar = Array(3, 6, 9)
         For i = 0 To UBound(ar)
            With .Cells(ar(i), 1)
                .Value = "Ячейка A" & ar(i)
                '
                'Создаётся квадрат в этой ячейке, для того чтобы к нему соеденить стрелку
                'координаты переписанны те-же что и у ячейки
                '
                Set ar(i) = .Parent.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height)
            End With
            If i Then
               '
               'Создаётся стрелка после того как создан первый квадрат
               '
               With .Shapes.AddConnector(msoConnectorStraight, 0, 0, 0, 0)
                   .Name = icn & .Parent.Shapes.Count
                   'Здесь можно настроить стиль линии
                   .Line.BeginArrowheadStyle = msoArrowheadTriangle
                   .Line.EndArrowheadStyle = msoArrowheadTriangle
                   'Соединение с предыдущим квадратом к его нижней части
                   .ConnectorFormat.BeginConnect .Parent.Shapes(ar(i - 1).Name), 3
                   'Соединение к этому квадрату к его верхней части
                   .ConnectorFormat.EndConnect .Parent.Shapes(ar(i).Name), 1
               End With
           End If
        Next
        'Стрелки указывают на ячейки теперь квадраты не нужны
        For Each el In ar: el.Delete: Next
        '=========
        If MsgBox("Удалить новую колонку ?", vbInformation Or vbYesNo) = vbNo Then Exit Sub
        'Удаляется новая колонка
        .[a:a].Delete
        'Удаляются так-же стрелки
        For Each el In .Shapes
           If InStr(1, el.Name, icn) Then el.Delete
        Next
    End With
 
End Sub

0 / 0 / 0

Регистрация: 02.01.2015

Сообщений: 7

02.01.2015, 18:53

[ТС]

Спасибо, я все понял.

Добавлено через 2 часа 36 минут
Еще один маленький вопрос, как настроить цвет стрелки? Тогда у меня сразу получится кодовое дерево!

~~Night Ranger~~

Заблокирован

02.01.2015, 19:12

Да очень просто, найдите у меня это место, впишите следущее:

Visual Basic

1
2
3

                   'Здесь можно настроить стиль линии
                   .Line.BeginArrowheadStyle = msoArrowheadTriangle
                    .Line.ForeColor.SchemeColor = 12

и будет синий цвет

Добавлено через 2 минуты
а так, будет сначало желтый, а потом синий

Visual Basic

1	.Line.ForeColor.SchemeColor = 12 + i

Добавлено через 7 минут
Забыл еще сказать, новейшие Excel-ы (выше 2003) тормозят
и не всегда поспевают за командами наподобие соеденений стрелок
поэтому рекомендую перед сложными операциями отключать все реакции

Application.EnableEvents = False

а по окончанию опять включить: Application.EnableEvents = True

Добавлено через 6 минут
Вот, чтобы долго не рассказывать:

Кликните здесь для просмотра всего текста

Visual Basic

Sub Connector()
    Const icn = "iConnector"
    Application.EnableEvents = False
    With ActiveSheet
    
        If MsgBox("Создать новую колонку ?", vbInformation Or vbYesNo) = vbNo Then Exit Sub
         .[a:a].Insert: ar = Array(3, 6, 9)
         For i = 0 To UBound(ar)
            With .Cells(ar(i), 1)
                .Value = "Ячейка A" & ar(i)
                '
                'Создаётся квадрат в этой ячейке, для того чтобы к нему соеденить стрелку
                'координаты переписанны те-же что и у ячейки
                '
                Set ar(i) = .Parent.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height)
            End With
            If i Then
               '
               'Создаётся стрелка после того как создан первый квадрат
               '
               With .Shapes.AddConnector(msoConnectorStraight, 0, 0, 0, 0)
                   .Name = icn & Rnd * 10 ^ 10
                   'Здесь можно настроить стиль линии
                   .Line.BeginArrowheadStyle = msoArrowheadTriangle
                    .Line.ForeColor.SchemeColor = Choose(i, 12, 13)
                    
                   .Line.EndArrowheadStyle = msoArrowheadTriangle
                   'Соединение с предыдущим квадратом к его нижней части
                   .ConnectorFormat.BeginConnect .Parent.Shapes(ar(i - 1).Name), 3
                   'Соединение к этому квадрату к его верхней части
                   .ConnectorFormat.EndConnect .Parent.Shapes(ar(i).Name), 1
               End With
           End If
        Next
        'Стрелки указывают на ячейки теперь квадраты не нужны
        For Each el In ar: el.Delete: Next
        '=========
        If MsgBox("Удалить новую колонку ?", vbInformation Or vbYesNo) = vbNo Then Exit Sub
        'Удаляется новая колонка
        .[a:a].Delete
        'Удаляются так-же стрелки
        For Each el In .Shapes
           If InStr(1, el.Name, icn) Then el.Delete
        Next
    End With
    Application.EnableEvents = True
End Sub

Spectator7675

0 / 0 / 0

Регистрация: 02.01.2015

Сообщений: 7

02.01.2015, 19:53

[ТС]

Еще раз спасибо!

Добавлено через 39 минут
Я думал, что все понял, но оказывается ничего не понял .
в этой

Visual Basic

1	.[a:a].Sort .[a1], xlDescending

строке у вас [a:a] — рейндж по столбцам (то есть берется столбец А), .Sort вызов процедуры сортировки, .[a1] начальная ячейка, ну с xlDescending все понятно.
Но у меня-то i+1 столбец, конкретной буквы я не знаю. Короче, объясните мне на моем собственном примере пожалуйста, как реализовать эту сортировку, чтобы я уже окончательно все понял.

Visual Basic

Sub list1()
 x = 50
 For i = 1 To 50
  If x - 2 > 0 Then
   For j = 1 To x - 2
    Cells(j, i) = Cells(j, i + 1)
   Next
  End If
  Cells(x - 1, i + 1) = Cells(x - 1, i) + Cells(x, i)
  
 
  x = x - 1
  If x - 2 = 0 Then Exit Sub
 Next
End Sub

Думаю где должна быть сортировка i+1 столбца и так ясно .
Просто первый раз сталкиваюсь с синтаксисом VBA отсюда столько глупых вопросов.

~~Night Ranger~~

Заблокирован

02.01.2015, 20:20

Cells ( [номер строки], [номер столбца]
мою трактовку:
.[a:a].Sort .[a1], xlDescending

можно вполне изменить на эту
.Columns(1).Sort .Cells(1, 1), xlDescending

или на эту, значение i должно быть номером сортируемого столбца
.Columns(i).Sort .Cells(1, i), xlDescending

Добавлено через 6 минут
я заметил что многие пользуются наподобии такой записи [a:a] и решил мода такая
хотя на самом деле привык к нормальным записям и точным обращениям

Добавлено через 4 минуты
Можно и в конкретную букву преобразовать:

Visual Basic

1 2	i = 1 Range(Chr(i + 64) & 1).Select

получится тоже что и [a1].select
просто не хочу вас сильно грузить

0 / 0 / 0

Регистрация: 02.01.2015

Сообщений: 7

02.01.2015, 20:25

[ТС]

Спасибо, так гораздо понятнее. Мне еще много костылей придется в программу вставить, но думаю с остальным я сам справлюсь .

~~Night Ranger~~

Заблокирован

02.01.2015, 20:29

Сообщение от Spectator7675

но думаю с остальным я сам справлюсь

зря вы так уверенны, я хоть все эти мелочи и знаю, но всёравно нет-нет да подсмотрю как делают другие, еще не спрашивал ничего, но скоро обязательно спрошу
чтонибудь этакое из за угла

Spectator7675

0 / 0 / 0

Регистрация: 02.01.2015

Сообщений: 7

02.01.2015, 22:07

[ТС]

Да уж, тут вы были правы. В общем вот такая программа у меня получилась

Visual Basic

Sub www()
 x = 49
 For i = 1 To 49
  If x - 2 > 0 Then
   For j = 1 To x - 2
    Cells(j, i + 1) = Cells(j, i)
   Next j
  End If
  Cells(x - 1, i + 1) = Cells(x - 1, i) + Cells(x, i)
  Columns(i + 1).Sort.Cells(1, i + 1).xlDescending
  x = x - 1
  If x - 2 = 0 Then Exit Sub
 Next i
End Sub

Выдает ошибку 1004 «невозможно получить свойство sort класса range». Второй столбец строит верно, но не сортирует. Не подскажете в чем дело?

Добавлено через 6 минут
А все, со всем разобрался, волшебная кнопочка help мне все объяснила

~~Night Ranger~~

Заблокирован

03.01.2015, 02:26

в 10-й строчке точку у вас не надо ставить ( .Cells )
а если и ставите, то надо делать зазор между словами
у меня это значит что .Cells относится к набору With
в данном случае активному листу (With ActiveSheet)
и даже если в момент выполнения лист поменяется, ( всякое бывает ) то ссылки будут продолжать работать в объявленной группе

0 / 0 / 0

Регистрация: 02.01.2015

Сообщений: 7

03.01.2015, 13:53

[ТС]

В общем-то построение таблицы-то у меня получилось, но коды по ней вручную построишь . Ну то есть можно, но я не настолько сошел с ума. Впрочем преподу это и не нужно, достаточно воспользоваться онлайн калькулятором и просто записать результат в отчет лабы, но так ведь не интересно, верно ? Поэтому у меня появилось идея, как при помощи трех рекурсивных функций из этой таблицы построить код Хаффмана для каждого символа, единственная проблема — я не знаю как сделать так, чтобы функция брала данные из одного листа эксель, а результат записывала в другой.

~~Night Ranger~~

Заблокирован

03.01.2015, 14:00

Сообщение от Spectator7675

В общем-то построение таблицы-то у меня получилось, но коды по ней вручную построишь

Да всё можно решить

Сообщение от Spectator7675

я не знаю как сделать так, чтобы функция брала данные из одного листа эксель, а результат записывала в другой

и это тоже можно

Источник