ГлавнаяMS ACCESS Функции чтения и изменения части составной строки
Функции чтения и изменения части составной строки
Автор Александр Романов
03.02.2005 г.
Часто возникает необходимость сохранить в одной строке несколько независимых по смыслу друг от друга значений (например при использовании свойства TAG или свойства OpenArgs). Предлагаемые функции позволяют легко извлекать или изменять любую часть подобной "составной" строки.
'Функция Записи части составной строки (т.е. строки, состоящей как-бы из нескольких "ячеек") Public Function SetStringPart(ByVal strPartValue As String, _ ByVal strWholeString As String, _ ByVal strPartNumber As Long, _ ByVal strDivider As String, _ ByVal lngMaxLenth As Long) As String ' strPartValue - значение "ячейки" строки (если параметр равен ""(пустая строка), то "ячейка" очищается, при этом она остается ' strWholeString - значение всей исходной строки ' strPartNumber - порядковый номер "ячейки" строки ' strDivider - разделитель "ячеек" (может быть произвольное количество символов), если разделитель не будет соответствовать реальному разделителю в строке, то функция будет считать всю строку за 1-ую ячейку ' lngMaxLenth - максимальная длина строки на выходе (для отключения проверки на максимальную длину укажите этот параметр = 0)
If strDivider = "" Or strPartNumber <= 0 Then SetStringPart = strWholeString GoTo exx End If Dim i As Long Dim first As Long Dim last As Long Dim part As Long Dim strTemp As String Dim NoDiv As Boolean Dim OldWholeString As String OldWholeString = strWholeString part = 1 first = 1 last = 1 If strWholeString <> "" Then If InStr(1, strWholeString, strDivider) <> 1 Then strWholeString = strDivider & strWholeString part = 0 NoDiv = True End If Do Until part = strPartNumber first = InStr(last, strWholeString, strDivider, vbBinaryCompare) last = InStr(first + Len(strDivider), strWholeString, strDivider, vbBinaryCompare) part = part + 1 If last = 0 Then Exit Do Loop Else part = 1 End If If part = strPartNumber And strWholeString <> "" Then If last = 0 And first = 1 Then strTemp = Left(strWholeString, Len(strDivider)) & strPartValue ElseIf last = 0 And first > 1 Then strTemp = Left(strWholeString, first + Len(strDivider) - 1) & strPartValue ElseIf part = 1 And first = 1 And last > 0 Then strTemp = Left(strWholeString, first - 1) & strPartValue & Mid(strWholeString, last) NoDiv = False Else strTemp = Left(strWholeString, first + Len(strDivider) - 1) & strPartValue & Mid(strWholeString, last) End If If NoDiv Then SetStringPart = Mid(strTemp, Len(strDivider) + 1) Else SetStringPart = strTemp End If ElseIf part = strPartNumber And strWholeString = "" Then SetStringPart = strPartValue ElseIf part < strPartNumber And strWholeString <> "" Then If NoDiv Then strTemp = Mid(strWholeString, Len(strDivider) + 1) Else strTemp = strWholeString End If For i = 1 To strPartNumber - part strTemp = strTemp & strDivider Next i SetStringPart = strTemp & strPartValue ElseIf part < strPartNumber And strWholeString = "" Then strTemp = Mid(strWholeString, Len(strDivider) + 1) For i = 1 To strPartNumber - part strTemp = strTemp & strDivider Next i SetStringPart = strTemp & strPartValue End If
exx:
If lngMaxLenth <> 0 And Len(SetStringPart) > lngMaxLenth Then MsgBox "Длина новой строки превышает допустимый размер в " & lngMaxLenth & " символов", vbCritical If Len(OldWholeString) > lngMaxLenth Then MsgBox "Исходная строка превышает допустимый размер в " & lngMaxLenth & " символов", vbCritical SetStringPart = "" Else SetStringPart = OldWholeString End If End If End Function
'Функция Чтения части составной строки (т.е. строки, состоящей как-бы из нескольких "ячеек") Public Function GetStringPart(ByVal strWholeString As String, _ ByVal strPartNumber As Long, _ ByVal strDivider As String) As String
' strWholeString - значение всей исходной строки ' strPartNumber - порядковый номер "ячейки" строки ' strDivider - разделитель "ячеек" (может быть произвольное количество символов), если разделитель не будет соответствовать реальному разделителю в строке, то функция будет считать всю строку за 1-ую ячейку
If strDivider = "" Or strPartNumber <= 0 Then GetStringPart = "": Exit Function: Dim first As Long Dim last As Long Dim part As Long part = 1 first = 1 last = 1 If strWholeString <> "" Then If InStr(1, strWholeString, strDivider) <> 1 Then strWholeString = strDivider & strWholeString part = 0 End If Do Until part = strPartNumber first = InStr(last, strWholeString, strDivider, vbBinaryCompare) + Len(strDivider) last = InStr(first, strWholeString, strDivider, vbBinaryCompare) part = part + 1 If last = 0 Then Exit Do Loop Else GetStringPart = "" Exit Function End If If part = strPartNumber Then If last = 0 Then GetStringPart = Mid(strWholeString, first) Else GetStringPart = Mid(strWholeString, first, last - first) End If End If End Function