ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / помогите исправить функцию, чтобы она работала
25 сообщений из 51, страница 2 из 3
  2  все
помогите исправить функцию, чтобы она работала
    #34798183
Фотография HandKot
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
HandKot
Участник
вы просто пишете текст процедуры(функции) и посылаете его в insertLines

и так для каждой ячейки

I Have Nine Lives You Have One Only
THINK!
...
Рейтинг: 0 / 0
13.09.2007, 15:50:15
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34798255
Фотография HandKot
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
HandKot
Участник
не уверен, но вроде можно сделать так
создаете свою ф-цию

потом по надобности, используя
Код: plaintext
1.
2.
3.
4.
Метод ReplaceLine 
Замещает одну строку программы другой. 

Синтаксис 
объект.ReplaceLine(строка, текст)

заменяете условие на нужное, а потом выполняете ее

I Have Nine Lives You Have One Only
THINK!
...
Рейтинг: 0 / 0
13.09.2007, 16:06:09
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34798326
KL (XL)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
KL (XL)
Участник
При беглом взгляде на решение с пом. манипуляций с объектом VBAProject, создается впечатление, что результата таким образом достичь можно, но какой ценой:

- в проекте VBA нужно создать ссылку на соотв. библиотеку Microsoft Visual Basic For Applications Extensibility #.#
- для Office 2002-2007 в меню Сервис-Макрос-Безопасность... , закладка Надежные издатели , нужно отметить Доверять доступ к Visual Basic Project
- условия в ячейке нужно будет писать по-английски
- условия в ячейке нужно будет писать в синтаксисе VBA
- условия в ячейке нужно будет писать в текстовом формате

Отсюда вопрос - оно вообще надо?

Ведь берутся же откуда-то параметры для функции. Если они жестко записаны в процедуре вызываемой кнопкой, то почему нельзя их жестко записать в ячейках на листе

[B1]=1
[C1]=2
[D1]=3

и проверять условия нормальной формулой

[A1]=AND(B1=1,C1=2,D1=3)

а результат передавать ввиде параметра процедуры

Код: plaintext
1.
2.
3.
4.
5.
Sub uslovie(blResult As Boolean)
     If blResult then MsgBox("работает") 
End Sub
Sub Test()
     uslovie Лист1.Cells( 1 , 1 )
End Sub

KL
[MVP - Microsoft Excel]
...
Рейтинг: 0 / 0
13.09.2007, 16:20:32
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34798360
KL (XL)
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
KL (XL)
Участник
Если не хочется тратить ячейки, то можно создать именованные формулы, что-то типа прилагаемого файла

KL
[MVP - Microsoft Excel]
...
Рейтинг: 0 / 0
13.09.2007, 16:27:52
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34799557
Klera
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Klera
Гость
может кто с такой проблемой сталкивался,HELP
...
Рейтинг: 0 / 0
14.09.2007, 08:08:33
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34799559
Klera
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Klera
Гость
HELP
...
Рейтинг: 0 / 0
14.09.2007, 08:09:09
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34799634
Klera
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Klera
Гость
Не пойму как передать параметры в метод InsertLines
еще раз напомню задачу, нужно с помощью метода InsertLines вставить в тело функции условие, которое должно отработать, условие считаное с определенной ячейки и содержит условие на параметры функции

Помогите кто сталкивался...
...
Рейтинг: 0 / 0
14.09.2007, 08:54:11
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34799644
Klera
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Klera
Гость
KL (XL)Если не хочется тратить ячейки, то можно создать именованные формулы, что-то типа прилагаемого файла

KL
[MVP - Microsoft Excel]

мне надо именно функцию, если можно было бы так сделать в виде процедуры я бы с удовольствием (просто такая ситуация-есть проет на VBA, который работает, раньше условие было вшито в функцию, сейчас мне надо чтобы это условие задавал пользователь для этой функции), прочитала про InsertLines и не поняла как бы мне это использовать для моего случая....?
...
Рейтинг: 0 / 0
14.09.2007, 09:00:42
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34799651
Klera
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Klera
Гость
HandKotне уверен, но вроде можно сделать так
создаете свою ф-цию

потом по надобности, используя
Код: plaintext
1.
2.
3.
4.
Метод ReplaceLine 
Замещает одну строку программы другой. 

Синтаксис 
объект.ReplaceLine(строка, текст)

заменяете условие на нужное, а потом выполняете ее

I Have Nine Lives You Have One Only
THINK!

Идея хорошая, но у меня что то пока не получается...
...
Рейтинг: 0 / 0
14.09.2007, 09:03:36
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34799655
Klera
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Klera
Гость
HandKotвы просто пишете текст процедуры(функции) и посылаете его в insertLines

и так для каждой ячейки

I Have Nine Lives You Have One Only
THINK!

Можно пример?
...
Рейтинг: 0 / 0
14.09.2007, 09:05:36
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34799776
Фотография HandKot
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
HandKot
Участник
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
Function Test(NewCode As String) As String
    
    Test = ""
    Application.VBE.CodePanes( 1 ).CodeModule.ReplaceLine  6 , "    If " & NewCode & " then "
    'положение нижеследующей строки не менять иначе менять параметры метода ReplaceLine
    If DlyaZameny Then
        Test = NewCode
    End If
    
    Exit Function
EH:
    Test = "Ошибка "
End Function

только есть небольшие (большие проблемы)

ЗЫЖ попробуйте и найдите решение своей задачи другим путем ИМХО

I Have Nine Lives You Have One Only
THINK!
...
Рейтинг: 0 / 0
14.09.2007, 09:56:34
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34799954
Klera
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Klera
Гость
написала:

Код: plaintext
1.
2.
3.
4.
5.
6.
With Application.ActiveWorkbook.VBProject.VBComponents("main").CodeModule
.DeleteLines  15 
.InsertLines  15 , st
End With
If CBool(t >  0 ) = True Then
MsgBox ("УРА")
End If

работает, перекидывает считанное условие с ячейки, но не проверяет.
как сделать так чтобы условие проверялось при этом????
...
Рейтинг: 0 / 0
14.09.2007, 10:43:37
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34799973
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Не нужно заморачиваться изменением кода на лету, если не нравится предложение KL(XL), то вот вам решение другим путём
Если в ячейке писать условия такого типа k=1 and t=2 (только без проверок типа isNull)
То код следующий

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
Sub main()
 s = uslovie( 2 ,  1 ,  3 )
End Sub

Function uslovie(t As Integer, k As Integer, l As Integer)
Dim flag
flag = Evaluate("(" & Replace(Replace(Replace(Replace(Лист1.Cells( 1 ,  1 ), _
                      "k", k), "t", t), "l", l), "and", ")*(") & ")")

If flag Then
   MsgBox ("условие выполнено")
 Else
   MsgBox ("условие НЕвыполнено")
End If

End Function

Если в ячейке писать условия такого типа (k=0)*(t=2)*(ISNUMBER(l)) , т.е. по правилам Эксель и используя функции Эксель обязательно в английском их написании, то код можно подсократить до следующего

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
Sub main()
 s = uslovie( 2 ,  0 ,  3 )
End Sub

Function uslovie(t As Integer, k As Integer, l As Integer)
Dim flag
flag = Evaluate(Replace(Replace(Replace(Лист1.Cells( 1 ,  1 ), _
                      "k", k), "t", t), "l", l))

If flag Then
   MsgBox ("условие выполнено")
 Else
   MsgBox ("условие НЕвыполнено")
End If

End Function
...
Рейтинг: 0 / 0
14.09.2007, 10:49:23
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34800019
Klera
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Klera
Гость
DeggasadНе нужно заморачиваться изменением кода на лету, если не нравится предложение KL(XL), то вот вам решение другим путём
Если в ячейке писать условия такого типа k=1 and t=2 (только без проверок типа isNull)
То код следующий

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
Sub main()
 s = uslovie( 2 ,  1 ,  3 )
End Sub

Function uslovie(t As Integer, k As Integer, l As Integer)
Dim flag
flag = Evaluate("(" & Replace(Replace(Replace(Replace(Лист1.Cells( 1 ,  1 ), _
                      "k", k), "t", t), "l", l), "and", ")*(") & ")")

If flag Then
   MsgBox ("условие выполнено")
 Else
   MsgBox ("условие НЕвыполнено")
End If

End Function

Если в ячейке писать условия такого типа (k=0)*(t=2)*(ISNUMBER(l)) , т.е. по правилам Эксель и используя функции Эксель обязательно в английском их написании, то код можно подсократить до следующего

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
Sub main()
 s = uslovie( 2 ,  0 ,  3 )
End Sub

Function uslovie(t As Integer, k As Integer, l As Integer)
Dim flag
flag = Evaluate(Replace(Replace(Replace(Лист1.Cells( 1 ,  1 ), _
                      "k", k), "t", t), "l", l))

If flag Then
   MsgBox ("условие выполнено")
 Else
   MsgBox ("условие НЕвыполнено")
End If

End Function


условие будут писатьпользователи, и я думаю что так они не смогут написать, поэтому надо программировать на лету, то что я написала выше вставляет, нужный код, но не проверят, сейчас бьюсь нам тем чтобы функция проверяла, пробовала через goto и на это условие, программа зацыкливает...
как исправить пока не знаю...
...
Рейтинг: 0 / 0
14.09.2007, 11:01:16
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34800058
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Klera
условие будут писатьпользователи, и я думаю что так они не смогут написать?
Как они не смогут написать?
может так
[k=1 and t=2
или вот так
(k=1)*(t=2)

А как тогда смогут?
...
Рейтинг: 0 / 0
14.09.2007, 11:08:22
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34800278
Klera
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Klera
Гость
В общем для тех кто тож столкнулся с такой задачей, выкладываю РАБОЧИЙ код

Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
Sub main()
peredat
S = uslovie( 1 ,  2 ,  3 )
End Sub
Sub peredat()
Dim st As String
st = "if " & Лист1.Cells( 2 ,  1 ).Value & " then"
With Application.ActiveWorkbook.VBProject.VBComponents("main").CodeModule
.DeleteLines  14 
.InsertLines  14 , st
End With
End Sub
Function uslovie(t As Integer, k As Integer, l As Integer)
If t >  0  Then
MsgBox ("выполняется условие")
End If
MsgBox ("расчет окончен")
End Function

Пользуйтесь.
P.S.не забудьте для этого установить флажок "доверять доступ к Visual Basic Project"(меню сервис-макрос-безопастность-вкладка Надежные издатели)
...
Рейтинг: 0 / 0
14.09.2007, 11:50:27
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34800412
Фотография HandKot
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
HandKot
Участник
зачем делать так
Код: plaintext
1.
.DeleteLines  14 
.InsertLines  14 , st
когда можно просто
Код: plaintext
.ReplaceLine  14 , st

ну это так к слову

I Have Nine Lives You Have One Only
THINK!
...
Рейтинг: 0 / 0
14.09.2007, 12:23:25
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34800459
Klera
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Klera
Гость
Может кто знает, как написать обработчик на считанную ячейку, то есть если там написано что то типа "t in (0)" или еще какая нить ерунда которая не преобразуется в корректное услоие, чтобы не вставлял строку, а выходил из процедуры (sub peredat)
???
...
Рейтинг: 0 / 0
14.09.2007, 12:31:10
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34800773
Klera
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Klera
Гость
То есть мне нужна функция которая при считывании с ячейки проверяет выражение на правильность синтаксиса выражения
???
...
Рейтинг: 0 / 0
14.09.2007, 13:30:38
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34800915
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
KleraТо есть мне нужна функция которая при считывании с ячейки проверяет выражение на правильность синтаксиса выражения
???

В моём то варианте всё тип-топ с ошибками
Последний раз предлагаю
В ячейку записываем k=0 and t=2 and ISNUMBER(l) , т.е. условия с обычными опреаторами, либо функции Эксель, только в английском написании.
Код следующий

Код: plaintext
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.
Sub main()
 S = uslovie( 2 ,  0 ,  3 )
End Sub

Function uslovie(t As Integer, k As Integer, l As Integer)
Dim flag  As Boolean

On Error Resume Next
flag = Evaluate("(" & Replace(Replace(Replace(Replace(Лист1.Cells( 1 ,  1 ), _
                      "k", k), "t", t), "l", l), "and", ")*(") & ")")
Debug.Print flag
Debug.Print Err.Number
If Err.Number <>  0  Then
   Debug.Print Err.Number
   flag = False
   MsgBox ("неверное условие")
   Exit Function
End If
On Error GoTo  0 

If flag Then
   MsgBox ("условие выполнено")
 Else
   MsgBox ("условие НЕвыполнено")
End If
End Function
...
Рейтинг: 0 / 0
14.09.2007, 14:04:10
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34800920
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
Эти строки лишние
Код: plaintext
1.
Debug.Print flag
Debug.Print Err.Number
...
Рейтинг: 0 / 0
14.09.2007, 14:05:24
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34800985
Klera
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Klera
Гость
Хмммммм..........
мне просто нужен мой вариант........
как исправить?
...
Рейтинг: 0 / 0
14.09.2007, 14:22:19
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34801022
Deggasad
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Deggasad
Участник
KleraХмммммм..........
мне просто нужен мой вариант........
как исправить?
никак
...
Рейтинг: 0 / 0
14.09.2007, 14:31:48
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34803746
Klera
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Klera
Гость
Никто не сталкивался с такой проблемой?
...
Рейтинг: 0 / 0
17.09.2007, 06:47:52
| Ответить | Цитировать | Написать  
помогите исправить функцию, чтобы она работала
    #34803795
Klera
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Klera
Гость
То есть как осуществить перехват синтаксической ошибки

Код: plaintext
syntax error

??
Модератор:
Внимательно читаем правила .
...
Рейтинг: 0 / 0
17.09.2007, 08:06:35
| Ответить | Цитировать | Написать  
25 сообщений из 51, страница 2 из 3
  2  все
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / помогите исправить функцию, чтобы она работала
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=61&msg=34798326&tid=2182269]:
 0ms
get settings:
 10ms
get forum list:
 15ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 34ms
get topic data:
 8ms
get forum data:
 2ms
get page messages:
 55ms
get tp. blocked users:
 1ms
others: 217ms
total:  348ms
созд. / загр.: 348ms
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]