Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Линия с условием равенства либо ее абсцисс, либо ординат - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Линия с условием равенства либо ее абсцисс, либо ординат (Макросы/Sub)
Линия с условием равенства либо ее абсцисс, либо ординат
SergVrn Дата: Суббота, 16.12.2017, 23:57 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 49
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Добрый вечер.
Помогите с решением.

Как макросом - провести линии меду центрами ячеек, с условием, что если - либо обе абсциссы линии, либо обе ее ординаты одинаковы - только тогда линия рисуется ?
К сообщению приложен файл: 954664.xls(42.5 Kb)
 
Ответить
СообщениеДобрый вечер.
Помогите с решением.

Как макросом - провести линии меду центрами ячеек, с условием, что если - либо обе абсциссы линии, либо обе ее ординаты одинаковы - только тогда линия рисуется ?

Автор - SergVrn
Дата добавления - 16.12.2017 в 23:57
bmv98rus Дата: Воскресенье, 17.12.2017, 10:28 | Сообщение № 2
Группа: Проверенные
Ранг: Старожил
Сообщений: 1180
Репутация: 204 ±
Замечаний: 0% ±

Excel 2013/2016
SergVrn, А что конкретно у вас не выходит?
 
Ответить
СообщениеSergVrn, А что конкретно у вас не выходит?

Автор - bmv98rus
Дата добавления - 17.12.2017 в 10:28
SergVrn Дата: Воскресенье, 17.12.2017, 15:18 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 49
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
А что конкретно у вас не выходит?

Ну - вообще ВСЕ - не выходит.
Я не знаю как эту задачу решить.

Разве что есть примерная идея реализации:
1)Макрос соединяет все без исключения ячейки - линиями.
2)Определяет линии у которых - либо обе абсциссы равны, либо обе ординаты равны - и удаляет их.

Но вот как это реализовать - я не знаю.


Сообщение отредактировал SergVrn - Воскресенье, 17.12.2017, 15:27
 
Ответить
Сообщение
А что конкретно у вас не выходит?

Ну - вообще ВСЕ - не выходит.
Я не знаю как эту задачу решить.

Разве что есть примерная идея реализации:
1)Макрос соединяет все без исключения ячейки - линиями.
2)Определяет линии у которых - либо обе абсциссы равны, либо обе ординаты равны - и удаляет их.

Но вот как это реализовать - я не знаю.

Автор - SergVrn
Дата добавления - 17.12.2017 в 15:18
bmv98rus Дата: Воскресенье, 17.12.2017, 17:51 | Сообщение № 4
Группа: Проверенные
Ранг: Старожил
Сообщений: 1180
Репутация: 204 ±
Замечаний: 0% ±

Excel 2013/2016
SergVrn
Если ничего не выходит, значит что-то сделано. Можно на это взглянуть?
1. чтоб определить, надо или е надо соединять пару, надо сравнить индекс столбца и строки ячеек. При равенстве одного из двух, нужна линия.
2. Рисуем линию из координат Cells.top+Cells.hight/2 и Cells.left+cells.width/2 до точки середины второй ячейки.


Сообщение отредактировал bmv98rus - Воскресенье, 17.12.2017, 23:18
 
Ответить
СообщениеSergVrn
Если ничего не выходит, значит что-то сделано. Можно на это взглянуть?
1. чтоб определить, надо или е надо соединять пару, надо сравнить индекс столбца и строки ячеек. При равенстве одного из двух, нужна линия.
2. Рисуем линию из координат Cells.top+Cells.hight/2 и Cells.left+cells.width/2 до точки середины второй ячейки.

Автор - bmv98rus
Дата добавления - 17.12.2017 в 17:51
doober Дата: Воскресенье, 17.12.2017, 18:03 | Сообщение № 5
Группа: Друзья
Ранг: Обитатель
Сообщений: 461
Репутация: 224 ±
Замечаний: 0% ±

Excel 2007
Я не знаю как эту задачу решить.

Геометрия говорит, что если угол наклона прямой равен 0,90,180,270 - эту линию рисуем.




Сообщение отредактировал doober - Воскресенье, 17.12.2017, 18:04
 
Ответить
Сообщение
Я не знаю как эту задачу решить.

Геометрия говорит, что если угол наклона прямой равен 0,90,180,270 - эту линию рисуем.

Автор - doober
Дата добавления - 17.12.2017 в 18:03
bmv98rus Дата: Воскресенье, 17.12.2017, 18:58 | Сообщение № 6
Группа: Проверенные
Ранг: Старожил
Сообщений: 1180
Репутация: 204 ±
Замечаний: 0% ±

Excel 2013/2016
doober, а геометрия не говорит, по отношению к чему этот угол считать? :-) Или вы предлакаете сперва высчитать угловой коэффицент прямой проходящей через две точки и после этого принять решение? в таком случае как раз равенство X1,X2 и Y1,Y2 даст 0 в разнице и зачем тогда все эти расчеты?
 
Ответить
Сообщениеdoober, а геометрия не говорит, по отношению к чему этот угол считать? :-) Или вы предлакаете сперва высчитать угловой коэффицент прямой проходящей через две точки и после этого принять решение? в таком случае как раз равенство X1,X2 и Y1,Y2 даст 0 в разнице и зачем тогда все эти расчеты?

Автор - bmv98rus
Дата добавления - 17.12.2017 в 18:58
SergVrn Дата: Воскресенье, 17.12.2017, 20:12 | Сообщение № 7
Группа: Пользователи
Ранг: Новичок
Сообщений: 49
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Если ничего не выходит, значит что-то сделано. Можно на это взглянуть

Ну продвинулся я - не ахти как далеко.
Сейчас, в настоящее время имеющийся макрос - просто соединяет все без исключения "ячейки с единицами" - линиями.
Получается такая - хаотическая паутина.

А вот если бы как-то наклонные линии (после работы данного макроса) - автоматически удалить - вот этого я сделать не могу.
К сообщению приложен файл: 7816193.xls(99.5 Kb)


Сообщение отредактировал SergVrn - Воскресенье, 17.12.2017, 20:13
 
Ответить
Сообщение
Если ничего не выходит, значит что-то сделано. Можно на это взглянуть

Ну продвинулся я - не ахти как далеко.
Сейчас, в настоящее время имеющийся макрос - просто соединяет все без исключения "ячейки с единицами" - линиями.
Получается такая - хаотическая паутина.

А вот если бы как-то наклонные линии (после работы данного макроса) - автоматически удалить - вот этого я сделать не могу.

Автор - SergVrn
Дата добавления - 17.12.2017 в 20:12
Roman777 Дата: Воскресенье, 17.12.2017, 20:57 | Сообщение № 8
Группа: Проверенные
Ранг: Ветеран
Сообщений: 846
Репутация: 106 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
SergVrn, как Вам и говорили, можно условие соответствующее, поставить:


Ну а если Вам принципиально создавать линию через центры ячеек, то стоит использовать :
[vba]
Код
Cells(i,j).Left+Cells(i,j).width/2
Cells(i,j).Top+Cells(i,j).height/2
[/vba]


Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Воскресенье, 17.12.2017, 21:06
 
Ответить
СообщениеSergVrn, как Вам и говорили, можно условие соответствующее, поставить:


Ну а если Вам принципиально создавать линию через центры ячеек, то стоит использовать :
[vba]
Код
Cells(i,j).Left+Cells(i,j).width/2
Cells(i,j).Top+Cells(i,j).height/2
[/vba]

Автор - Roman777
Дата добавления - 17.12.2017 в 20:57
doober Дата: Воскресенье, 17.12.2017, 21:15 | Сообщение № 9
Группа: Друзья
Ранг: Обитатель
Сообщений: 461
Репутация: 224 ±
Замечаний: 0% ±

Excel 2007
зачем тогда все эти расчеты?

Надо все правильно делать с заделом на будущее.
Есть у меня класс геометрия.
Производятся в нем любые расчеты .
Надо найти точки пересечения окружности с прямой, вызвал функцию, передал параметры, получил результат.
Надо вычислить площадь многоугольника, передал массив точек, на выходе площадь.
И т.д.


 
Ответить
Сообщение
зачем тогда все эти расчеты?

Надо все правильно делать с заделом на будущее.
Есть у меня класс геометрия.
Производятся в нем любые расчеты .
Надо найти точки пересечения окружности с прямой, вызвал функцию, передал параметры, получил результат.
Надо вычислить площадь многоугольника, передал массив точек, на выходе площадь.
И т.д.

Автор - doober
Дата добавления - 17.12.2017 в 21:15
SergVrn Дата: Воскресенье, 17.12.2017, 21:37 | Сообщение № 10
Группа: Пользователи
Ранг: Новичок
Сообщений: 49
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Roman777, а вот этот фрагмент:
[vba]
Код
Cells(i,j).Left+Cells(i,j).width/2
Cells(i,j).Top+Cells(i,j).height/2
[/vba]
Его куда именно - в макросе добавлять ?


Сообщение отредактировал SergVrn - Воскресенье, 17.12.2017, 21:37
 
Ответить
СообщениеRoman777, а вот этот фрагмент:
[vba]
Код
Cells(i,j).Left+Cells(i,j).width/2
Cells(i,j).Top+Cells(i,j).height/2
[/vba]
Его куда именно - в макросе добавлять ?

Автор - SergVrn
Дата добавления - 17.12.2017 в 21:37
Roman777 Дата: Воскресенье, 17.12.2017, 21:49 | Сообщение № 11
Группа: Проверенные
Ранг: Ветеран
Сообщений: 846
Репутация: 106 ±
Замечаний: 0% ±

Excel 2007, Excel 2013
SergVrn,  Замените строки в "'''''''''''''''''''" на:
[vba]
Код

''''''''''''''''''''''''''''''''''''''
        If (rn.Left = Cells(.A.Y, .A.X).Left) Or (rn.Top = Cells(.A.Y, .A.X).Top) Then
            Set ash(UL) = ws.Shapes.AddLine(rn.Left + rn.Width / 2, rn.Top + rn.Height / 2, _
            Cells(.A.Y, .A.X).Left + Cells(.A.Y, .A.X).Width / 2, Cells(.A.Y, .A.X).Top + Cells(.A.Y, .A.X).Height / 2) '.Select
            
            ash(UL).Select
        End If
'''''''''''''''''''''''''''''''''''''
[/vba]
Но в целом, над макросом стоило бы ещё поработать, поскольку он создаёт линии, повторяющие геометрию предыдущих линий... или так и задумано?


Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Воскресенье, 17.12.2017, 21:51
 
Ответить
СообщениеSergVrn,  Замените строки в "'''''''''''''''''''" на:
[vba]
Код

''''''''''''''''''''''''''''''''''''''
        If (rn.Left = Cells(.A.Y, .A.X).Left) Or (rn.Top = Cells(.A.Y, .A.X).Top) Then
            Set ash(UL) = ws.Shapes.AddLine(rn.Left + rn.Width / 2, rn.Top + rn.Height / 2, _
            Cells(.A.Y, .A.X).Left + Cells(.A.Y, .A.X).Width / 2, Cells(.A.Y, .A.X).Top + Cells(.A.Y, .A.X).Height / 2) '.Select
            
            ash(UL).Select
        End If
'''''''''''''''''''''''''''''''''''''
[/vba]
Но в целом, над макросом стоило бы ещё поработать, поскольку он создаёт линии, повторяющие геометрию предыдущих линий... или так и задумано?

Автор - Roman777
Дата добавления - 17.12.2017 в 21:49
SergVrn Дата: Воскресенье, 17.12.2017, 21:59 | Сообщение № 12
Группа: Пользователи
Ранг: Новичок
Сообщений: 49
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
поскольку он создаёт линии, повторяющие геометрию предыдущих линий

Да действительно - некоторые линии перекрываются.
А это как можно решить ?

Я просто не понимаю как сформулировать алгоритм для удаления перекрывающихся линий.
У них ведь - либо абсциссы, либо ординаты - одинаковые, и по основному-то условию - они проходят.
 
Ответить
Сообщение
поскольку он создаёт линии, повторяющие геометрию предыдущих линий

Да действительно - некоторые линии перекрываются.
А это как можно решить ?

Я просто не понимаю как сформулировать алгоритм для удаления перекрывающихся линий.
У них ведь - либо абсциссы, либо ординаты - одинаковые, и по основному-то условию - они проходят.

Автор - SergVrn
Дата добавления - 17.12.2017 в 21:59
bmv98rus Дата: Воскресенье, 17.12.2017, 23:17 | Сообщение № 13
Группа: Проверенные
Ранг: Старожил
Сообщений: 1180
Репутация: 204 ±
Замечаний: 0% ±

Excel 2013/2016
SergVrn,
1. формируем массив ячеек с 1, тупка перебирая используемую область, а еще проще быстрее наверно не пустые взять, через SpecialCells
2. Без преебора не обойтись, но берем проверяем пары сравнивая 1я последующими и при выполнении условия сохраняем отдельно , ну елси геометрия, то длинну линии по вертикали и горизонтали отдельно. По окончанию рисуем эти две линии.
3. повторяем 2, но 2я сравнивается с оставшимися... и так далее.
тем самым решится вопрос перекрывающих линий.

 
Ответить
СообщениеSergVrn,
1. формируем массив ячеек с 1, тупка перебирая используемую область, а еще проще быстрее наверно не пустые взять, через SpecialCells
2. Без преебора не обойтись, но берем проверяем пары сравнивая 1я последующими и при выполнении условия сохраняем отдельно , ну елси геометрия, то длинну линии по вертикали и горизонтали отдельно. По окончанию рисуем эти две линии.
3. повторяем 2, но 2я сравнивается с оставшимися... и так далее.
тем самым решится вопрос перекрывающих линий.


Автор - bmv98rus
Дата добавления - 17.12.2017 в 23:17
SergVrn Дата: Понедельник, 18.12.2017, 03:43 | Сообщение № 14
Группа: Пользователи
Ранг: Новичок
Сообщений: 49
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
bmv98rus, я не понял - так условие удаления одной из перекрывающейся линий - как должно выглядеть ?

То есть должен быть какой-то итоговый массив линий (после работы основного макроса).

И начинает действовать что-то типа условия : проверяется - для каждой линии - либо одна из ее абсцисс - находится между абсциссами одной из прочих линий массива.
Либо одна из ординат этой линии - находится между ординатами одной из прочих линий массива.
Те нарисованные линии, которые подходят под это условие - удаляются с листа.

Или вы написали более простое решение ?
(Я просто не понял, что у вас в трех пунктах написано.)
 
Ответить
Сообщениеbmv98rus, я не понял - так условие удаления одной из перекрывающейся линий - как должно выглядеть ?

То есть должен быть какой-то итоговый массив линий (после работы основного макроса).

И начинает действовать что-то типа условия : проверяется - для каждой линии - либо одна из ее абсцисс - находится между абсциссами одной из прочих линий массива.
Либо одна из ординат этой линии - находится между ординатами одной из прочих линий массива.
Те нарисованные линии, которые подходят под это условие - удаляются с листа.

Или вы написали более простое решение ?
(Я просто не понял, что у вас в трех пунктах написано.)

Автор - SergVrn
Дата добавления - 18.12.2017 в 03:43
bmv98rus Дата: Понедельник, 18.12.2017, 07:50 | Сообщение № 15
Группа: Проверенные
Ранг: Старожил
Сообщений: 1180
Репутация: 204 ±
Замечаний: 0% ±

Excel 2013/2016
SergVrn, По попробую по другому. В экселе у вас ограничено пространство левым верхним углом и с него начнется перебор используемой областью, и это можно использовать.
Берем первую точку X1Y1и вторую X2Y2, проверяем на условие совпадения X1=X2 Или Y1=Y2 , Каким методом - сравнением в каком ряду или столбце ячейки или именно коррдинат ,Вам решать. При совпадении запоминаем две различных точки , с равными иксами и игриками, одна для вертикального и одна для горизонтального отрезка. Bерем следующую точку X3Y3 и также перебором X1=X3 Или Y1=Y3 ,при совпадении сравниваем растония Abs(X3-x1)< Abs(X2-X1) Если да, на место X2Y2 запоминам X3Y3 в соответвующей горизонтали или вертикали. таким образом доходите до конца и по завершении у вас не более трех точек X1Y1 и е1 возможные пары, с минимальным растояниями между ними. Можно рисовать отрезки от X1Y1 lдо полученных точек (их может не быть, если X1Y1 "на отшибе".
Теперь повторяем все это, но от точки X2Y2.
В целом вопрос уже не связан с Excel. С ним связано только определение центра координат ячейки.


Сообщение отредактировал bmv98rus - Понедельник, 18.12.2017, 14:54
 
Ответить
СообщениеSergVrn, По попробую по другому. В экселе у вас ограничено пространство левым верхним углом и с него начнется перебор используемой областью, и это можно использовать.
Берем первую точку X1Y1и вторую X2Y2, проверяем на условие совпадения X1=X2 Или Y1=Y2 , Каким методом - сравнением в каком ряду или столбце ячейки или именно коррдинат ,Вам решать. При совпадении запоминаем две различных точки , с равными иксами и игриками, одна для вертикального и одна для горизонтального отрезка. Bерем следующую точку X3Y3 и также перебором X1=X3 Или Y1=Y3 ,при совпадении сравниваем растония Abs(X3-x1)< Abs(X2-X1) Если да, на место X2Y2 запоминам X3Y3 в соответвующей горизонтали или вертикали. таким образом доходите до конца и по завершении у вас не более трех точек X1Y1 и е1 возможные пары, с минимальным растояниями между ними. Можно рисовать отрезки от X1Y1 lдо полученных точек (их может не быть, если X1Y1 "на отшибе".
Теперь повторяем все это, но от точки X2Y2.
В целом вопрос уже не связан с Excel. С ним связано только определение центра координат ячейки.

Автор - bmv98rus
Дата добавления - 18.12.2017 в 07:50
SergVrn Дата: Понедельник, 18.12.2017, 17:30 | Сообщение № 16
Группа: Пользователи
Ранг: Новичок
Сообщений: 49
Репутация: 0 ±
Замечаний: 0% ±

Excel 2013
Roman777, bmv98rus - спасибо за ответы
 
Ответить
СообщениеRoman777, bmv98rus - спасибо за ответы

Автор - SergVrn
Дата добавления - 18.12.2017 в 17:30
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Линия с условием равенства либо ее абсцисс, либо ординат (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс цитирования
© 2010-2018 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!