[Leizar]

Очень прошу помочь со следующими вопросамии в VBA, связаными со следующими задачами:
1)Два отрезка на плоскости заданы координатами своих концов. Определить, имеют ли эти отрезки общие точки.
Примечание:Необходимо рассмотреть различные случаи взаимной ориентации отрезков: на одной прямой, на паралельных прямых или пересекающихся.

2)в массиве T(k) найтипервый и последний нулевые элементы.
3) От каждого из заданых m чисел x1, x2,…,xm отнять их среднее арифметическое: xi = xi – xср ,
xср = 1/m∑_(i=1)^m xi, i=1,2,…,m.
И что бы результаты были не месте исходных данных!

[Дрюха]

Подниму данную тему (да будут милостливы модераторы), дабы не знаю, как в случае создания новой обозвать ее.
Господа, который час уже ломаю голову над созданием макроса в Excel (знания нулевые) Необходимо вот что:
допустим, есть три числа a,b,c (b=const,c=const). Как мне сделать макрос, чтобы он подбирал значение a, чтобы удовлетворялось условие a*b=c. полагаю ,что это должен быть какой-то цикл (идет подбор числа a с каким-то определенным шагом, типа: если ai*b<c, то aj=ai+delta, где дельта -определенный шаг и далее по кругу. Ну и все почти что то же самое, если значение ai*b>c), но все, что пытался сделать, насмарку.
Буду чрезвычайно рад помощи!!
Заранее спасибо

[ETCartman]

a=c/b

[Олег (jr.)]

Сообщение от Дрюха Подниму данную тему (да будут милостливы модераторы), дабы не знаю, как в случае создания новой обозвать ее. Господа, который час уже ломаю голову над созданием макроса в Excel (знания нулевые) Необходимо вот что: допустим, есть три числа a,b,c (b=const,c=const). Как мне сделать макрос, чтобы он подбирал значение a, чтобы удовлетворялось условие a*b=c. полагаю ,что это должен быть какой-то цикл (идет подбор числа a с каким-то определенным шагом, типа: если ai*b<c, то aj=ai+delta, где дельта -определенный шаг и далее по кругу. Ну и все почти что то же самое, если значение ai*b>c), но все, что пытался сделать, насмарку. Буду чрезвычайно рад помощи!! Заранее спасибо

Пробуй

Код:

[Выделить все]

Option Explicit

Const b As Double = 1.2345
Const c As Double = 5.4321
Sub testiteration()
Dim a As Double
Dim condition As Boolean

Dim step As Double
step = 0.000125
Dim start As Double
start = 0.1
Dim epsilon As Double
epsilon = 0.0001

Dim i As Long
i = 0
a = start
Do
condition = ((a * b) < (c - epsilon))
a = a + step

If condition = False Then
Exit Do
End If
Loop Until condition = False
With ThisWorkbook.ActiveSheet
.Range("A1:B7").Clear
.Range("A1:A7").NumberFormat = "@"
.Range("B2:B7").NumberFormat = "0.0000"
.Range("A1") = "Исходные данные"
.Range("A2") = "B="
.Range("A3") = "C="
.Range("A4") = "Точность="
.Range("A5") = "Приращение="
.Range("A6") = "Математически А= C/B="
.Range("A7") = "Расчетное А="
.Range("B2") = b
.Range("B3") = c
.Range("B4") = step
.Range("B5") = epsilon
.Range("B6") = c / b
.Range("B7") = a
.Range("A:B").Columns.AutoFit
.Range("B7").Select

End With
MsgBox "Done"
End Sub

Sub numb()
MsgBox ThisWorkbook.ActiveSheet.Range("B1").NumberFormat
End Sub

[Дрюха]

Сообщение от ETCartman a=c/b

Я знал, что кто-то это напишет Не смог я правильно разьяснить смысл проблемы в пол-шестого утра) а так обязательно порпобую Ваш вариант, уж больно он привлекателен!!!

Сообщение от Олег (jr.) Пробуй

Немного уточню (по крайней мере, постараюсь). Есть в реальной задаче число a (ячейка A2), которое входит в выражение X(там действительно будет выражение, просто в данный момент эта ячейка численно равна ячейке A2), находящееся в ячейке F5. Так вот, нужно подобрать перебором такое значение A2, чтобы произведение выражения X (ячейка F5) на число b (ячейка G5) было равно числу C (ячейка H5)

Пробую редактировать Ваш код под себя, но не выходит. прикладываю файл, гляньте и ,по возможности, дайте рецензию, что я не сделал не так (ибо макрос не хочет считаться).

[Олег (jr.)]

Сообщение от Дрюха да я походу вообще не выспался

Когда выспишься объясни все заново, поскольку:
в ячейке А1 нет вообще никакого числа так же как нет никакой фрмулы в ячейке В1, а гадать - где что я не буду

[Дрюха]

Вроде отредактировал

[BetoN]

2Дрюха
Excel 2007, Данные - Работа с данными - Анализ "что-если" - Подбор параметра

[Олег (jr.)]

Сообщение от Дрюха Вроде отредактировал

Завтра постараюсь

[Дрюха]

Надеюсь на Вашу помощь!
BetoN, нужен именно макрос. но все равно спасибо

[Олег (jr.)]

Попробуй еще раз

Код:

[Выделить все]

Option Explicit


Sub testiteration()
Application.Volatile True
Dim a As Double
Dim b As Double
Dim c As Double
Dim condition As Boolean

b = CDbl(Worksheets("1").Range("g5"))
c = Worksheets("1").Range("h5")
Dim step As Double
step = 0.00000001
Dim start As Double
start = 0.00000001
Dim epsilon As Double
epsilon = 0.00000001

Dim i As Long
i = 0
a = start
Do
a = a + step
condition = ((a * b) < (c - epsilon))
If condition = False Then
Exit Do
End If
Loop Until condition = False
With Sheets("1")
.Range("a8") = a '<--поменяй адрес ячейки
End With


''/*======= Только для проверки(удалить строчки)
With Sheets("1")

.Range("a9") = .[a8] * .[g5]
.Range("a10") = .[a9] < .[h5] + epsilon
End With ==========='/*

MsgBox "Done"
End Sub

[Дрюха]

Все отлично. Спасибо , Олег (jr.), буду теперь использовать ваш макрос. ибо это только вершина айсберга

[Cfytrr]

Знающие люди помогите написать макрос
Есть исходные данные A, B и C есть решение D
как сделать так, что бы решение D было найдено в каждой из строк исходных данных

з.ы. В задаче, решение D занимает два листа сплошных формул.

[Кулик Алексей aka kpblc]

Вариантов два. Первый - писать все внутри ячейки (т.е. =бла-бла-бла). Вариант второй: написать пользовательскую функцию, принимающую в качестве параметра несколько ячеек и вычисления выполнять уже в ней. По скорости быстродействия второй (особенно для длинных вычислений) практически гарантированно проиграет.
Для представленной формулы можешь посмотреть такой файлец...

[Cfytrr]

Сообщение от Кулик Алексей aka kpblc написать пользовательскую функцию, принимающую в качестве параметра несколько ячеек и вычисления выполнять уже в ней

Я правильно понимаю, что в одной ячейке придется описать все действия с исходными данными (полный алгоритм решения)? Если то так то такой вариант не подойдет, так как в реальном расчете решение D сложнее чем в примере и с A, B и С производятся не только арифметические , но и логические действия

[KronSerg]

Логические действия тоже возможно прописать в формуле, но на мой взгляд, проще сделать по варианту два из №14
есть ещё третий вариант, расписать в дополнительных колонках промежуточные результаты вычислений зависящие друг от друга чтобы не городить очень длинную формулу в одной ячейке, потом промежуточные результаты можно просто скрыть.

[Cfytrr]

Кулик Алексей aka kpblc, KronSerg, Спасибо, буду пробовать.

[Кулик Алексей aka kpblc]

При очень (подчеркиваю - очень!) больших вычислениях фактически выбор между пользовательской формулой и #16. Основной вопрос в скорости быстродействия: как правило, пользовательская формула работает чрезвычайно медленно, и, если есть возможность, от нее надо отказаться. То есть вычисления производить в отдельных ячейках (кстати, иногда все вычисления "прячутся" на отдельном скрытом листе, с именованием ячеек и т.д. )

[Brain Murder]

Весь интернет обшарил не могу найти как привязать элемент ActiveX к ячейке. Мне нужно чтобы скрытый комбобокс появлялся при нажатии на ячейку принадлежащую определенному диапазону. Через "именованные диапазоны" способ меня не устраивает, мне нужен быстрый поиск элемента по первым буквам. Как запустить что-либо по нажатию на ячейку понятно. Классика...

Код:

[Выделить все]

    Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("b2:b1000")) Is Nothing Then
и пошло поехало...

но возникают вопросы:
1. Как указать диапазон всего столбца? Не Range("b2:b1000") а от b2 и пока таблица не кончится.
2. Как координаты комбобокса задать чтоб он точно рядом с поюзаной ячейкой появлялся?
И кстати, чем элементы ActiveX отличаются от Элементов управления?

[T-Yoke]

Сообщение от Brain Murder Весь интернет обшарил не могу найти как привязать элемент ActiveX к ячейке. Мне нужно чтобы скрытый комбобокс появлялся при нажатии на ячейку принадлежащую определенному диапазону....

Посмотри здесь думаю должно устроить. Описаны четыре варианта.

[Brain Murder]

T-Yoke, спасибо, но эту статью я видел, там ни на один мой вопрос ответа не дается. Там делают activeX, но он висит в воздухе и привязан к какой-то одной ячейке, короче не то. На первый свой вопрос я нашел ответ:

Код:

[Выделить все]

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lLastRow As Long
lLastRow = Cells(Rows.Count, 2).End(xlUp).Row
If Target.Cells.Count > 1 Then Exit Sub
If Not Application.Intersect(Target, Range(Cells(2, 5), Cells(lLastRow + 5, 5))) Is Nothing Then
...

но как быть со вторым?

Сообщение от Brain Murder 2. Как координаты комбобокса задать чтоб он точно рядом с поюзаной ячейкой появлялся? И кстати, чем элементы ActiveX отличаются от Элементов управления

[Dorogon]

Уважаемые гуру, подскажите как в Excel'e выполнить подбор значения по приведенной ниже таблице по трем параметрам?

[KronSerg]

Сложное форматирование для использования стандартных функций, попробуй такую:

Код:

[Выделить все]

Function forDorogon(кат_сложн As Byte, выс_зд As Byte, кат_зд As Byte)
Dim x11(), x12(), x13(), x21(), x22(), x23()
Dim r(16, 16, 16) As Long
Dim vis()
Dim i As Byte
x11 = Array(4829, 4408, 4075, 3699, 3415, 3175, 2970, 2715, 2461, 2280, 2050, 1893, 1722, 1546, 1360, 1248)
x12 = Array(5837, 5455, 5049, 4716, 4364, 3992, 3718, 3434, 3234, 2979, 2784, 2583, 2431, 2221, 2060, 1967)
x13 = Array(7593, 7201, 6810, 6419, 6066, 5680, 5328, 4922, 4594, 4207, 3933, 3738, 3449, 3146, 2901, 2671)
x21 = Array(6688, 6243, 5827, 5430, 5034, 4638, 4295, 3928, 3591, 3273, 2950, 2725, 2490, 2294, 2074, 1864)
x22 = Array(8204, 7774, 7299, 6879, 6468, 6047, 5616, 5201, 4814, 4432, 4085, 3733, 3415, 3126, 2833, 2559)
x23 = Array(10274, 9829, 9349, 8889, 8459, 8028, 7612, 7172, 6727, 6340, 5920, 5504, 5132, 4834, 4520, 4251)
vis = Array(8, 9, 10, 12, 14, 16, 18, 20, 23, 26, 30, 35, 40, 45, 50)
For i = 0 To 15
r(1, 1, i) = x11(i): r(1, 2, i) = x12(i): r(1, 3, i) = x13(i): r(2, 1, i) = x21(i): r(2, 2, i) = x22(i): r(2, 3, i) = x23(i)
Next i
For i = 1 To 16
If выс_зд < vis(i) Then Exit For
Next i
rez = r(кат_сложн, кат_зд, i)
forDorogon = rez
End Function

[Олег (jr.)]

Сообщение от Dorogon Уважаемые гуру, подскажите как в Excel'e выполнить подбор значения по приведенной ниже таблице по трем параметрам?

Элементарно, Watson,
используйте именованные диапазоны

Ну так что не нужен пример?

~'J'~

[Dorogon]

Сообщение от Олег (jr.) Ну так что не нужен пример?

С огромным удовольствием посмотрел бы пример.

[Олег (jr.)]

Сообщение от Dorogon С огромным удовольствием посмотрел бы пример.

Для начала создай именованные диапазоны или как их там правильно
называют
Для нижеприведнного кода используй следующие имена
1. Высоты - создай диапазон с именем "Height"
2. Для категорий здания создай диапазоны которые начинаются
с "CatBld" и добавляй для каждого цифру соответствующую категории:
"CatBld1","CatBld2","CatBld3" и тп
3.Соответственно для дипазонов категорий сложности работ
аналогично п.п.2:
"CatWork1","CatWork2","CatWork3" и тп

Открой Эксель и добавь этот код
(измени по свои опции - имя листаб имена диапазонов и тд)

Код:

[Выделить все]

Option Explicit

Sub Demo()
Dim hgt, catw, cat, catb
catw = 1 'category of building
hgt = 22.5 'building height
catb = "I" 'category of work level

Dim height As Range
Dim catbld As Range
Dim catwork As Range
Select Case catb

Case "I": cat = 1
Case "II": cat = 2
Case "III": cat = 3
Case "IV": cat = 4
Case "V": cat = 5
End Select
Set height = Sheets("Sheet1").Names("Sheet1!Height").RefersToRange
Set catwork = Sheets("Sheet1").Names("Sheet1!CatWork" & CStr(catw)).RefersToRange 'diapazone "I-II-III"
Set catbld = Sheets("Sheet1").Names("Sheet1!CatBld" & CStr(catw)).RefersToRange
catbld.Select

Dim ar() As Long
Dim row As Long

Dim col As Long
col = FindIfInside(height, hgt)(1)

row = catbld.Cells(cat, 10).row
'MsgBox "R= " & row & "; C= " & col 'debug only
Dim findRng As Range
Set findRng = Sheets("Sheet1").Cells(row, col)
findRng.Interior.ColorIndex = 24 'debug only
MsgBox "Found Value At: " & findRng.Value
findRng.Select
Dim mydata As DataObject
Set mydata = New DataObject
mydata.SetText (findRng.Text)
mydata.GetText (1)'<--копируется результат в буфер, потом вставляй куда хочешь
End Sub

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'

Public Function FindIfInside(rng As Range, xval As Variant) As Long()
Dim outArr(1) As Long
 Dim find As Variant
 find = FindIfTrue(rng.Value2, xval)
Dim c As Object

With rng
   Set c = .find(find, LookIn:=xlValues) '5
    If Not c Is Nothing Then

       outArr(0) = c.row: outArr(1) = c.Column
    End If
End With

Set c = Nothing

FindIfInside = outArr

End Function
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'

Public Function FindByValue(rng As Range, xval As Variant) As Long()
Dim outArr(1) As Long
' xval = CVar(Round(CDbl(xval), 2))
Dim c As Object

With rng
   Set c = .find(xval, LookIn:=xlValues) '5
    If Not c Is Nothing Then

       outArr(0) = c.row: outArr(1) = c.Column
    End If
End With

Set c = Nothing

FindByValue = outArr

End Function

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'

Private Function ParseText(txt As String, ht As Variant) As Boolean

Dim lim() As Double
Dim x, i, n
x = Split(txt, " ")
n = 0
For i = 0 To UBound(x)
If IsNumeric(x(i)) Then
ReDim Preserve lim(n)
lim(n) = CDbl(x(i))
n = n + 1
End If
Next

If UBound(lim) = 0 Then
If InStr(1, txt, "От", vbBinaryCompare) > 0 Then
ParseText = CDbl(ht) <= lim(0)
ElseIf InStr(1, txt, "Св.", vbBinaryCompare) > 0 Then
ParseText = CDbl(ht) >= lim(0)
End If
ElseIf UBound(lim) = 1 Then
ParseText = IIf(CDbl(ht) >= lim(0) And CDbl(ht) <= lim(1), True, False)
End If


End Function

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'

Private Function FindIfTrue(arr As Variant, what As Variant) As Variant

Dim found As Variant
Dim i
For i = LBound(arr, 2) To UBound(arr, 2)
If ParseText(CStr(arr(1, i)), what) Then
found = CStr(arr(1, i))
Exit For
End If
Next i
FindIfTrue = found

End Function

Некоторые функции не используются
оставил на всякий

[простой]

Сообщение от Олег (jr.) Для начала создай именованные диапазоны или как их там правильно называют

А если есть всего один диапазон определенных чисел (допустим 1-15) в ячейке E5. Как сделать перебор данных чисел до тех пор пока сумма этого числа с числом из G5 не будет превышать число из Н5?
Что необходимо вырезать из Вашего кода? А то не пойму какая функция отвечает за перебор из диапазона.