Гость
Войти | Профиль | Очистить
Целевая тема:
Создать новую тему:
Автор:
Действия ...
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Своя функция в VBA / 4 сообщений из 4, страница 1 из 1
20.11.2006, 15:01
    #34141127
Smiler™
Smiler™
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Своя функция в VBA
Пишу в 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, 17:04
    #34141654
vkodor
vkodor
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Своя функция в VBA
Своя функция в 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
| Ответить | Цитировать | Написать  
25.11.2006, 02:52
    #34155089
SashaM
SashaM
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Своя функция в VBA
Код: 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
| Ответить | Цитировать | Написать  
27.11.2006, 10:39
    #34156870
vkodor
vkodor
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Своя функция в VBA
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
| Ответить | Цитировать | Написать  
Форумы / Visual Basic [игнор отключен] [закрыт для гостей] / Своя функция в VBA / 4 сообщений из 4, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали тему (0):
Читали форум (0):
Пользователи онлайн (0):
Польз. соглашение  
Полит. конфиден.  
созд. / загр.: 414ms
Закрыть
start [/forum/topic.php?fid=60&mobile=1&tid=2164916]:
 0ms
get settings:
 6ms
get forum list:
 11ms
check forum access:
 2ms
check topic access:
 2ms
track hit:
 161ms
get topic data:
 9ms
get forum data:
 2ms
get page messages:
 30ms
get tp. blocked users:
 2ms
others: 189ms
total:  414ms
x
x
Закрыть


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