Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.57/7: Рейтинг темы: голосов - 7, средняя оценка - 4.57
0 / 0 / 0
Регистрация: 16.05.2019
Сообщений: 33
1

Определение ближайшего адреса ячейки, подходящего по углу

04.09.2019, 12:48. Показов 1360. Ответов 13
Метки нет (Все метки)

Добрый день форумчане.
Возникла непростая проблема.
Помогите ее решить.

Суть проблемы такая.
Есть основная ячейка (ее адрес вписан в AQ3)
И есть дополнительная ячейка задающая угол (ее адрес вписан в AQ4)
Нужно определить - какой из ближайших к основной ячейке адресов, больше подходит под тот угол наклона, который задается дополнительной ячейкой.
Результирующий адрес - нужно вписать в ячейку AQ6.

Формулой это можно сделать вот так:
=АДРЕС(СТРОКА(ДВССЫЛ(AQ3))+ИНДЕКС({0:1:1:1:0:-1:-1:-1};ОКРУГЛ(ATAN2(СТОЛБЕЦ(ДВССЫЛ(AQ4))-СТОЛБЕЦ(ДВССЫЛ(AQ3));СТРОКА(ДВССЫЛ(AQ3))-СТРОКА(ДВССЫЛ(AQ4)))/ПИ()*4;0)+5);СТОЛБЕЦ(ДВССЫЛ(AQ3))+ИНДЕКС({-1:0:1:1:1:0:-1:-1};ОКРУГЛ(ATAN2(СТОЛБЕЦ(ДВССЫЛ(AQ4))-СТОЛБЕЦ(ДВССЫЛ(AQ3));СТРОКА(ДВССЫЛ(AQ3))-СТРОКА(ДВССЫЛ(AQ4)))/ПИ()*4;0)+4);4)

А вот как ту же самую операцию сделать макросом - я не понимаю.
Ответьте, если кто знает - как выполнить эту операцию макросом ?
Имеется ввиду - не добавить ту же самую формулу в макрос, а полностью определить нужный адрес - только макросом (без какого-либо использования формул).
0

Помощь в написании контрольных, курсовых и дипломных работ здесь.

Вложения
Тип файла: xls Вопрос.xls (31.0 Кб, 4 просмотров)
Лучшие ответы (1)
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
04.09.2019, 12:48
Ответы с готовыми решениями:

Определение адреса ячейки
Для поиска нужного значения в определённом диапазоне ячеек использую конструкцию типа: Set XXX =...

Определение адреса ячейки гиперссылки
Здравствуйте. Столкнулся со следующей проблемой. Есть книга Excell, в которой есть лист с...

Поиск ближайшего подходящего значения из таблицы
Здравствуйте, в Excel у меня есть таблица из разных значений P, которым соответствуют разные...

Определение адреса ячейки для задания диапазона
Здравствуйте ! Есть Таблица Excel, состоящая из трех столбцов с данными. Количество строк таблицы...

13
1414 / 975 / 304
Регистрация: 11.07.2014
Сообщений: 3,464
04.09.2019, 16:37 2
Кошка Софи, можно так
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Dim Rn As Range, Rd As Range, Cor As Double, I As Integer, J As Integer
Dim Xn As Double, Yn As Double, Xd As Double, Yd As Double
Dim Cmin As Double, Cor1 As Double, I1 As Integer, J1 As Integer
Sub Proba()
Set Rn = Range(Range("AQ3"))
Xn = Rn.Left + Rn.Width / 2: Yn = Rn.Top + Rn.Height / 2
Cor = Corner(0, 0): Cmin = 2
For I = -1 To 1
  For J = -1 To 1
    If Not (I = 0 And J = 0) Then
      Cor1 = Abs(Corner(I, J) - Cor)
      If Cor1 < Cmin Then Cmin = Cor1: I1 = I: J1 = J
    End If
  Next
Next
Range("AQ6") = Rn.Offset(I1, J1).Address(0, 0)
End Sub
Function Corner(I As Integer, J As Integer) As Double
Set Rd = IIf(I = 0 And J = 0, Range(Range("AQ4")), Rn.Offset(I, J))
Xd = Rd.Left + Rd.Width / 2: Yd = Rd.Top + Rd.Height / 2
Corner = (Xn - Xd) / Sqr((Xn - Xd) ^ 2 + (Yn - Yd) ^ 2)
End Function
0
0 / 0 / 0
Регистрация: 16.05.2019
Сообщений: 33
04.09.2019, 18:19  [ТС] 3
Burk, спасибо.
Но пока что-то не работает.

Например если указать удаленную ячейку - BE29, то макрос выдаст неправильный результат AJ11 (хотя это вообще другой угол, а больше подходит AJ13).
0
Вложения
Тип файла: xls Вопрос-.xls (46.0 Кб, 1 просмотров)
1414 / 975 / 304
Регистрация: 11.07.2014
Сообщений: 3,464
04.09.2019, 20:14 4
Кошка Софи, это при переходе в зеркальные четверти, посмотрю

Добавлено через 1 час 24 минуты
Кошка Софи, я изменил критерий и убралась зеркалка. Теперь выдает AH11 и это правильно, если исходить из вашего критерия ближайшего угла к направлению до дополнительной точки. Посмотрите внимательно по углу из середины ячейки AH11 до вашей внешней точки. Поэтому, если вы хотите совпадения с вашими результатами, то надо искать ближайшую не по углу на допточку, а ближайшую по расстоянию от середины ячейки до вашей линии. Завтра посмотрю, а то уже поздно.
0
1414 / 975 / 304
Регистрация: 11.07.2014
Сообщений: 3,464
05.09.2019, 03:28 5
Кошка Софи, никаких углов, просто по минимуму расстояния от центра жёлтой ячейки до допточки, проверьте
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Dim Rn As Range, Rd As Range, Cor As Double, I As Integer, J As Integer
Dim Xn As Double, Yn As Double, Xd As Double, Yd As Double, TF As Boolean
Dim Cmin As Double, Cor1 As Double, I1 As Integer, J1 As Integer
Sub Proba()
Set Rd = Range(Range("AQ4"))
Xd = Rd.Left + Rd.Width / 2: Yd = Rd.Top + Rd.Height / 2
Cor = Corner(0, 0): Cmin = 10000
For I = -1 To 1
  For J = -1 To 1
    If Not (I = 0 And J = 0) Then
      Cor1 = Corner(I, J) - Cor
      If Cor1 < Cmin Then Cmin = Cor1: I1 = I: J1 = J
    End If
  Next
Next
Range("AQ7") = Range(Range("AQ3")).Offset(I1, J1).Address(0, 0)
End Sub
Function Corner(I As Integer, J As Integer) As Double
Set Rn = Range(Range("AQ3")).Offset(I, J)
Xn = Rn.Left + Rn.Width / 2: Yn = Rn.Top + Rn.Height / 2
Corner = Sqr((Xn - Xd) ^ 2 + (Yn - Yd) ^ 2)
End Function
1
0 / 0 / 0
Регистрация: 16.05.2019
Сообщений: 33
05.09.2019, 03:59  [ТС] 6
Burk, ясно.
Но что-то все равно пока не очень хорошо работает.

Например если указать удаленную ячейку - O13, то макрос выдаст неправильный результат AH13 (хотя больше подходит AH12).
0
Вложения
Тип файла: xls Вопрос- - 2.xls (45.5 Кб, 1 просмотров)
1414 / 975 / 304
Регистрация: 11.07.2014
Сообщений: 3,464
05.09.2019, 05:04 7
Кошка Софи, надо определиться с критерием, что вы хотите. Сейчас по расстоянию и оно у AH13 минимальное.
Напишите, что вы хотите, например по точке пересечения стороны ячейки с прямой, тогда должна быть AH12.
0
0 / 0 / 0
Регистрация: 16.05.2019
Сообщений: 33
05.09.2019, 07:21  [ТС] 8
Цитата Сообщение от Burk Посмотреть сообщение
по точке пересечения стороны ячейки с прямой, тогда должна быть AH12.
Да, по точке пересечения стороны ячейки с прямой (только прямой, как фигуры - тут нет)
0
1414 / 975 / 304
Регистрация: 11.07.2014
Сообщений: 3,464
05.09.2019, 19:40 9
Кошка Софи, тружусь над этим, как только так сразу

Добавлено через 5 часов 49 минут
Кошка Софи, теперь учитывается и расположение и угол наклона. Маленько потестировал, пока норма. Пробуйте теперь вы.
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Dim Rn As Range, Rd As Range, Cor As Double, I As Integer, J As Integer
Dim Xn As Double, Yn As Double, Xd As Double, Yd As Double, TF As Boolean
Dim Cmin As Double, Cor1 As Double, I1 As Integer, J1 As Integer
Sub Proba()
Dim Sin45 As Double
Sin45 = 1# / Sqr(2#)
Set Rd = Range(Range("AQ4"))
Cor = Corner(0, 0): Cmin = 2
I = IIf(Cor <= -Sin45, 1, IIf(Cor > -Sin45 And Cor <= Sin45, 2, _
    IIf(Cor > Sin45, 3, 4)))
' 1 - верх, 2 - слева, 3 - низ, 4 - справа
Select Case I
Case 1, 3
  I = IIf(I = 1, -1, 1)
  For J = -1 To 1
    Cor1 = Abs(Corner(I, J) - Cor)
      If Cor1 < Cmin Then Cmin = Cor1: I1 = I: J1 = J
  Next
Case 2, 4
  J = IIf(I = 2, -1, 1)
  For I = -1 To 1
    Cor1 = Abs(Corner(I, J) - Cor)
      If Cor1 < Cmin Then Cmin = Cor1: I1 = I: J1 = J
  Next
End Select
Range("AQ7") = Range(Range("AQ3")).Offset(I1, J1).Address(0, 0)
End Sub
 
Function Corner(I As Integer, J As Integer) As Double
Set Rn = Range(Range("AQ3")).Offset(I, J)
Xn = Rd.Left - Rn.Left: Yn = Rd.Top - Rn.Top
Corner = Yn / Sqr(Xn ^ 2 + Yn ^ 2) 'sinus
End Function
1
1414 / 975 / 304
Регистрация: 11.07.2014
Сообщений: 3,464
06.09.2019, 03:51 10
Лучший ответ Сообщение было отмечено Кошка Софи как решение

Решение

Кошка Софи, нельзя поздно работать, замените строки 9-10 на
Visual Basic
1
I = IIf(Cor <= -Sin45, 1, IIf(Cor >= Sin45, 3, IIf(Xn < 0, 2, 4)))
1
0 / 0 / 0
Регистрация: 16.05.2019
Сообщений: 33
07.09.2019, 16:37  [ТС] 11
Burk, большое спасибо.

Но пока что - все-таки не работает.
Выставляю удаленную ячейку - AK30... и макрос выдает результат - AH13 (хотя больше подходит AI13)
А адрес AH13 - вообще другой угол имеет.
0
Вложения
Тип файла: xls Вопрос- - 3.xls (49.0 Кб, 2 просмотров)
1414 / 975 / 304
Регистрация: 11.07.2014
Сообщений: 3,464
07.09.2019, 19:24 12
Кошка Софи, запустил файл, который вы прислали и при нажатии на кнопку получил AI13

Добавлено через 10 минут
видимо забыли нажать на кнопку и осталось от предыдущей точки
0
0 / 0 / 0
Регистрация: 16.05.2019
Сообщений: 33
07.09.2019, 19:48  [ТС] 13
Burk, ну да, точно.
Тогда - действительно все работает.

Огромное вам спасибо за помощь.
0
1414 / 975 / 304
Регистрация: 11.07.2014
Сообщений: 3,464
08.09.2019, 06:32 14
Кошка Софи, примечание - это написано для одинаковых размеров ячеек, иначе надо будет учитывать высоту и ширину ячеек и углы секторов могут быть не 90 градусов
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
08.09.2019, 06:32

Заказываю контрольные, курсовые, дипломные работы и диссертации здесь.

Excel. Определение адреса ячейки по условию поиска и адрес следующей после нее
Здравствуйте. Все что смог найти по данному вопросу это как определить адрес формулами, а нужно...

Нахождение ближайшего адреса(номер дома) относительно точки
Использую yandex map kit 3.0.. Подскажите, как получить ближайший адрес относительно точки. ...

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

Определение подходящего возраста кандидатуры для вступления в брак
помогите пожалуйста с решением двух задач V.Операторы выбора 23. Составить программу для...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
14
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.