ReSQL.ru
     
powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Мобильная версия    Контакт    Правила    FAQ    Помощь
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Доб. в избранное | Игнор. тему | Прикреп. тему | Пометить прочит. / непрочит. | Фильтр
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Своя функция в VBA
4 сообщений из 4, страница 1 из 1
Своя функция в VBA
    #34141127
Smiler™
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Smiler™
Участник
Пишу в Exel-e функцию:

Public Function q() As String
Dim cn As New ADODB.Connection
Dim rst As New ADODB.Recordset
'Dim mystr2 As String
Dim mQuery As String
mystr2 = ""
'Set cn = New ADODB.Connection
With cn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.ConnectionString = "Data Source=" & ThisWorkbook.Path & _
"\" & ThisWorkbook.Name & ";Extended Properties=Excel 8.0;"
.CursorLocation = adUseClient
.Open
End With
mQuery = "select [Город] from [Лист1$] where [код]=23 group by [Город]"
rst.Open mQuery, cn
Do While rst.EOF = False
If rst.RecordCount > 1 Then
mystr2 = mystr2 & rst.Fields(0) & "-"
Else
mystr2 = mystr2 & rst.Fields(0)
End If
If rst.EOF = False Then
rst.MoveNext
End If
Loop
rst.Close
cn.Close
' MsgBox mystr2
q = mystr2
End Function

MsgBox mystr2 -выводит сообщение с правильнойй строкой (два раза почему-то), сама же функция возвращает 0.
Не подскажете что не так делаю?
...
Рейтинг: 0 / 0
20.11.2006, 15:01
| Ответить | Цитировать | Написать  
Своя функция в VBA
    #34141654
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
Своя функция в Exel
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
    mystr2 = ""
    If rst.RecordCount >  1  Then 'проверка что записи есть
        Do While rst.EOF ' крутим до конца recordset
            For i =  0  To rst.fields.Count -  1  'крутим по всем столбцам recordset
                If i = rst.fields.Count -  1  Then 'если последний столбец то без "& "-""
                    mystr2 = mystr2 & rst.fields(i)
                Else
                    mystr2 = mystr2 & rst.fields(i) & "-"
                End If
            Next
            rst.MoveNext
        Loop
    End If
...
Рейтинг: 0 / 0
20.11.2006, 17:04
| Ответить | Цитировать | Написать  
Своя функция в VBA
    #34155089
SashaM
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
SashaM
Участник
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
    mystr2 = ""
    If rst.RecordCount >  1  Then 'проверка что записи есть
        Do While rst.EOF ' крутим до конца recordset
            For i =  0  To rst.fields.Count -  1  'крутим по всем столбцам recordset
               mystr2 = mystr2 & rst.fields(i) & "-"
            Next
            rst.MoveNext
        Loop
        mystr2 = Left(mystr2, Len(mystr2) -  1 )
    End If
Так немного быстрее.
...
Рейтинг: 0 / 0
25.11.2006, 02:52
| Ответить | Цитировать | Написать  
Своя функция в VBA
    #34156870
vkodor
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
vkodor
Участник
SashaMТак немного быстрее.
Врёшь!!!
Сам-то проверял???

Код: 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.
26.
27.
28.
Sub ffff()
    a = Timer
    mystr2 = ""
    strSource = "C:\Curs.mdb"
    Set dbAccess = OpenDatabase(strSource, False, False, ";DATABASE=" & strSource)
    stSQL = "SELECT * FROM [Curs]"
    Set rst = dbAccess.OpenRecordset(stSQL)
    If rst.RecordCount >  0  Then 'проверка что записи есть
        For x =  1  To  100 
            rst.MoveLast
            rst.MoveFirst
            Do While Not rst.EOF ' крутим до конца recordset
                For i =  0  To rst.Fields.Count -  1  'крутим по всем столбцам recordset
                    If i = rst.Fields.Count -  1  Then 'если последний столбец то без "& "-""
                        mystr2 = mystr2 & rst.Fields(i)
                    Else
                        mystr2 = mystr2 & rst.Fields(i) & "-"
                    End If
                Next
                rst.MoveNext
            Loop
        Next
    End If
    rst.Close
    dbAccess.Close
    Set reRecordSet = Nothing
    Set dbAccess = Nothing
    MsgBox Timer - a
End Sub
3,8 сек



Код: 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 ffffy()
    a = Timer
    mystr2 = ""
    strSource = "C:\Curs.mdb"
    Set dbAccess = OpenDatabase(strSource, False, False, ";DATABASE=" & strSource)
    stSQL = "SELECT * FROM [Curs]"
    Set rst = dbAccess.OpenRecordset(stSQL)
    If rst.RecordCount >  0  Then 'проверка что записи есть
        For x =  1  To  100 
            rst.MoveLast
            rst.MoveFirst
            Do While Not rst.EOF ' крутим до конца recordset
                For i =  0  To rst.Fields.Count -  1  'крутим по всем столбцам recordset
                   mystr2 = mystr2 & rst.Fields(i) & "-"
                Next
                rst.MoveNext
            Loop
            mystr2 = Left(mystr2, Len(mystr2) -  1 )
        Next
    End If
    rst.Close
    dbAccess.Close
    Set reRecordSet = Nothing
    Set dbAccess = Nothing
    MsgBox Timer - a
End Sub
4,2 сек



P4 2.8GHz
...
Рейтинг: 0 / 0
27.11.2006, 10:39
| Ответить | Цитировать | Написать  
4 сообщений из 4, страница 1 из 1
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Своя функция в VBA
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение   Полит. конфиден.  
NoSQL.ru       Кролег: Проекты, Новости, Чат       РЕД ФОРУМ       Фотоальбом: Участники, Встречи
Закрыть
start [/forum/topic.php?fid=60&fpage=256&tid=2164916]:
 0ms
get settings:
 8ms
get forum list:
 15ms
check forum access:
 3ms
check topic access:
 3ms
track hit:
 50ms
get topic data:
 10ms
get forum data:
 3ms
get page messages:
 39ms
get tp. blocked users:
 1ms
others: 243ms
total:  375ms
созд. / загр.: 375ms
x
x
Закрыть


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