На листе находится несколько фигур и в некоторые ячейки вокруг них - вписан текст.
В желтой ячейке O6 - вписано название определенной фигуры.
Как макросом - выписать в диапазон O8:O13 - содержимое трех ближайших к указанной в желтой ячейке фигуре - ячеек ? (ячейки с нулями (0) и с пробелами (" ") - должны игнорироваться) (центром фигуры считается геометрический центр круга - то есть координаты + половина высоты либо ширины)
На листе находится несколько фигур и в некоторые ячейки вокруг них - вписан текст.
В желтой ячейке O6 - вписано название определенной фигуры.
Как макросом - выписать в диапазон O8:O13 - содержимое трех ближайших к указанной в желтой ячейке фигуре - ячеек ? (ячейки с нулями (0) и с пробелами (" ") - должны игнорироваться) (центром фигуры считается геометрический центр круга - то есть координаты + половина высоты либо ширины)rotten41
Здравствуйте, господа программисты. Это снова я. Помогите решить проблему.
На листе находится несколько фигур и в некоторые ячейки вокруг них - вписан текст.
В желтой ячейке O6 - вписано название определенной фигуры.
Как макросом - выписать в диапазон O8:O13 - содержимое трех ближайших к указанной в желтой ячейке фигуре - ячеек ? (ячейки с нулями (0) и с пробелами (" ") - должны игнорироваться) (центром фигуры считается геометрический центр круга - то есть координаты + половина высоты либо ширины)
Здравствуйте, господа программисты. Это снова я. Помогите решить проблему.
На листе находится несколько фигур и в некоторые ячейки вокруг них - вписан текст.
В желтой ячейке O6 - вписано название определенной фигуры.
Как макросом - выписать в диапазон O8:O13 - содержимое трех ближайших к указанной в желтой ячейке фигуре - ячеек ? (ячейки с нулями (0) и с пробелами (" ") - должны игнорироваться) (центром фигуры считается геометрический центр круга - то есть координаты + половина высоты либо ширины)rotten41
Очень рады. Геометрию вспоминайте сами, плохо я в школе геометрию учил.
[vba]
Код
Private Type CellPoint X As Single Y As Single vl As Variant End Type Sub Test() Dim X As Single, Y As Single, t() As CellPoint, paralast As Long Dim Sh As Worksheet Set Sh = ActiveSheet paralast = -1 ReDim ListPoint(0) For Each cel In Sh.UsedRange.Cells If Not (Trim(cel.Value) = "" Or Trim(cel.Value) = 0) Then paralast = paralast + 1 ReDim Preserve ListPoint(paralast) X = cel.Left + cel.Width / 2 Y = cel.Top + cel.Height / 2 ListPoint(paralast).X = X ListPoint(paralast).Y = Y ListPoint(paralast).vl = Trim(cel.Value) End If
Next For Each Shap In Sh.Shapes If Shap.AutoShapeType = msoShapeOval Then With Shap.DrawingObject.ShapeRange X = .Left + .Width / 2 Y = .Top + .Height / 2 Name_ = .Name Debug.Print Name_, X, Y End With End If Next
End Sub
[/vba]
Все необходимое есть, надо только ближайшие точки с массива ListPoin найти.
Очень рады. Геометрию вспоминайте сами, плохо я в школе геометрию учил.
[vba]
Код
Private Type CellPoint X As Single Y As Single vl As Variant End Type Sub Test() Dim X As Single, Y As Single, t() As CellPoint, paralast As Long Dim Sh As Worksheet Set Sh = ActiveSheet paralast = -1 ReDim ListPoint(0) For Each cel In Sh.UsedRange.Cells If Not (Trim(cel.Value) = "" Or Trim(cel.Value) = 0) Then paralast = paralast + 1 ReDim Preserve ListPoint(paralast) X = cel.Left + cel.Width / 2 Y = cel.Top + cel.Height / 2 ListPoint(paralast).X = X ListPoint(paralast).Y = Y ListPoint(paralast).vl = Trim(cel.Value) End If
Next For Each Shap In Sh.Shapes If Shap.AutoShapeType = msoShapeOval Then With Shap.DrawingObject.ShapeRange X = .Left + .Width / 2 Y = .Top + .Height / 2 Name_ = .Name Debug.Print Name_, X, Y End With End If Next
End Sub
[/vba]
Все необходимое есть, надо только ближайшие точки с массива ListPoin найти.doober
Сообщение отредактировал doober - Пятница, 29.09.2017, 01:44