Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / FAQ: Split для младших / 10 сообщений из 10, страница 1 из 1
16.04.2004, 16:55
    #32484744
Alexus12
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
FAQ: Split для младших
младших версий Access ;)

Ключевые слова для поиска:
разделить строку
деление строки
делить строку
(модераторы, помогайте!)

-----

Код: 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.
29.
30.
31.
Sub SplitNames(tString, tArray)
'Аналог Split из старших версий
'tString - входная строка для деления по пробелам
'tArray - выходной _динамический_ массив  (опеределенный в вызывающей функции 
'оператором  "Dim PersArray()"  - без указания размерностей)

Dim tmp, j As Long

ReDim tArray( 0 )

    For j =  1  To Len(tString)
    
        If Mid(tString, j,  1 ) =  " "  Then
          'новое слово
          If tmp <>  "" Then 
            ReDim Preserve tArray(UBound(tArray) + 1 )
            tArray(UBound(tArray)) = tmp
            tmp = " "
        Else If j = Len(tString) Then
            tmp = tmp + Mid(tString, j, 1 )
            If tmp <> "" Then ReDim Preserve tArray(UBound(tArray) +  1 )
            tArray(UBound(tArray)) = tmp
        Else
        
        tmp = tmp + Mid(tString, j,  1 )
        End If
    
    Next


End Sub


Глюки и баги - AS IS ;))))))))
...
Рейтинг: 0 / 0
16.04.2004, 16:56
    #32484746
Alexus12
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
FAQ: Split для младших
МАТЬ!!!
он строки перенес!
Выручайте, модераторы!...
...
Рейтинг: 0 / 0
16.04.2004, 17:35
    #32484845
Geo
Geo
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
FAQ: Split для младших
авторВыручайте, модераторы!...
Чем выручать?
...
Рейтинг: 0 / 0
16.04.2004, 17:37
    #32484849
Темный
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
FAQ: Split для младших
Moderator's action log:
Call UnPerenos_Mega_Func()
...
Рейтинг: 0 / 0
16.04.2004, 17:38
    #32484853
Владимир Саныч
Модератор форума
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
FAQ: Split для младших
Я уже отформатировал.
...
Рейтинг: 0 / 0
16.04.2004, 19:03
    #32485015
Serge Gavrilov
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
FAQ: Split для младших
Предлагаю вариант, более совпадающий по функциональности с оригинальной функцией Split
Код: 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.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
Public Function Split8(ByVal Expression As String, _
            Optional ByVal Delimiter As String =  " " , _
            Optional ByVal Limit As Long = - 1 , _
            Optional ByVal Compare As Integer = vbBinaryCompare) As Variant
    '-----------------------------------------------------------
    ' Inputs: String to search,
    '         delimiter string,
    '         optional replacement limit (default = - 1  .. ALL)
    '         optional string compare value (default vbBinaryCompare)
    ' Outputs: Array containing items found in the string
    '           based on the delimiter provided
    ' Original code by: John L. Viescas   5 -Sep- 2001 
    ' Extensively revised by: Dirk Goldgar  21-Jan-2002
    ' Last Revision: Dirk Goldgar   21 -Jan- 2002 
    ' Some Correction: Serge Gavrilov  21-Aug-2003
    ' ** Duplicates the functionality of the VB  6  SPLIT function.
    '-----------------------------------------------------------
    On Error GoTo HandleErr
    Dim lngCnt As Long
    Dim intIndex As Integer
    Dim lngPos As Long
    Dim lngI As Long
    Dim strArray() As String

    If (Compare < -1) Or (Compare > 2) Then
        Err.Raise 5
        Exit Function
    End If
   ' If count is zero, return an empty array
   ' If Limit = 0 
   ' or expression is zero length string then return an empty array
    If (Limit =  0 ) Or (Len(Expression) =  0  And Len(Delimiter) <>  0 ) Then
        Split8 = Array()
        Exit Function
    End If
    ' If the Delimiter is zero-length, return a 1-entry array
    If Len(Delimiter) = 0 Then
        ReDim strArray(0)
        strArray(0) = Expression
        Split8 = strArray
        Exit Function
    End If
    ' Start count at (Limit -  1 ) because function returns
    ' whatever is left at the end.
    lngCnt = Limit - 1
    ' Start scanning at the start of the string.
    lngPos =  1 
    ' Loop until the counter is zero.
    Do Until lngCnt = 0
        lngI = InStr(lngPos, Expression, Delimiter, Compare)
        ' If the delimiter was not found, end the loop.
        If lngI =  0  Then Exit Do
        ' Add 1 to the number returned.
        intIndex = intIndex + 1
        ' Expand the array to fit in a new element.
        ReDim Preserve strArray( 0  To intIndex -  1 )
        ' Use index - 1 .. zero-based array
        strArray(intIndex - 1) = Mid$(Expression, lngPos, lngI - lngPos)
        ' Advance past the found entry and the delimiter.
        lngPos = lngI + Len(Delimiter)
        lngCnt = lngCnt -  1 
    Loop
    ' Everything after the last delimiter found goes in the last entry of
    ' the array.
    intIndex = intIndex +  1 
    ReDim Preserve strArray( 0  To intIndex -  1 )
    If lngPos <= Len(Expression) Then
        strArray(intIndex -  1 ) = Mid$(Expression, lngPos)
    Else
        strArray(intIndex -  1 ) = vbNullString
    End If
    ' Return the result
    Split8 = strArray
HandleExit:
    Exit Function
HandleErr:
    MsgBox  "Split8 error #"  & Err.Number & vbCrLf & Err.Description, vbCritical
    Resume HandleExit
End Function
...
Рейтинг: 0 / 0
16.04.2004, 19:15
    #32485028
N_A
N_A
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
FAQ: Split для младших
У меня работает не правильно
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
Sub testSplit()
Dim PersArray()
Dim PersArray1() As String
Dim s As String
s =  "1   2   3    4   "
 SplitNames s, PersArray
 PersArray1 = Split(s)
 Stop
End Sub

результаты разные.
кому не лень проверяйте.
...
Рейтинг: 0 / 0
16.04.2004, 19:18
    #32485036
N_A
N_A
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
FAQ: Split для младших
2Serge Gavrilov
Все ОК!
...
Рейтинг: 0 / 0
04.06.2004, 03:39
    #32547714
Alexander Say
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
FAQ: Split для младших
' --------------------------------------------------------------------------
' Заполнение массива данными
' Входные параметры: {String} - Перечень значений разделенных сепаратором
' opt {String} - Сепаратор (Default - ",")
' Выходные : {Dim} - Массив значений
' --------------------------------------------------------------------------
Function OnArray(ByVal strArray As String, _
Optional ByVal strSeparator As String = ",")
Dim sArray()
Dim sArVal As String
Dim pArray As Long
Dim nPosSr As Long

'strArray = trim(strArray)
'strSeparator = trim(strSeparator)

ReDim sArray(pArray): sArray(pArray) = Null

If Len(strArray) > 0 And Len(strSeparator) > 0 Then
Do
nPosSr = InStr(strArray, strSeparator)
If nPosSr > 0 Then
sArVal = Left(strArray, nPosSr - Len(strSeparator))
strArray = Right(strArray, Len(strArray) - nPosSr)
Else
sArVal = strArray
End If
ReDim Preserve sArray(pArray)
sArray(pArray) = sArVal
pArray = pArray + 1
Loop While nPosSr > 0
End If
OnArray = sArray

End Function
...
Рейтинг: 0 / 0
04.06.2004, 06:40
    #32547733
Serge Gavrilov
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
FAQ: Split для младших
авторFunction OnArray(ByVal strArray As String, _
Optional ByVal strSeparator As String = ",")

Все нормально, только данная функция не аналогична функции Split по использованию и результату. Поэтому, применяя ее, надо это учитывать.
...
Рейтинг: 0 / 0
Форумы / Microsoft Access [игнор отключен] [закрыт для гостей] / FAQ: Split для младших / 10 сообщений из 10, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


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