Option
Explicit
Function
getnextuser(
ByVal
strMember
As
String
,
ByVal
strTroopsof
As
String
)
As
String
Dim
objCBData
As
DataObject
Dim
pointer
As
Long
, i
As
Integer
, posmember
As
Long
Dim
strPN
As
String
Set
objCBData =
New
DataObject
objCBData.GetFromClipboard
strPN = objCBData.getText
If
strPN =
""
Then
getnextuser =
""
:
Exit
Function
posmember = pos_in_text(strPN, strMember)
If
posmember > 0
Then
pointer = pos_in_text(strPN, strTroopsof, posmember)
If
pointer > 0
Then
getnextuser = getText(Right(strPN, Len(strPN) - posmember), strTroopsof)
Exit
Function
End
If
End
If
getnextuser =
""
End
Function
Function
getText(osel
As
String
, strSuch
As
String
)
As
String
Dim
nextLeer
As
Long
, pos
As
Long
pos = pos_in_text(osel, strSuch)
If
pos > 0
Then
If
InStr(pos, osel,
" "
) = pos
Then
nextLeer = InStr(pos + 1, osel,
" "
)
Else
nextLeer = InStr(pos, osel,
" "
)
End
If
getText = Mid(osel, pos, nextLeer - pos)
Else
getText =
""
End
If
End
Function
Function
pos_in_text(suchtext
As
String
, suchzeichen
As
String
,
Optional
start
As
Long
)
As
Long
If
IsMissing(start)
Or
start = 0
Then
If
InStr(suchtext, suchzeichen) = 0
Then
pos_in_text = 0
Exit
Function
Else
pos_in_text = InStr(suchtext, suchzeichen) + Len(suchzeichen)
End
If
Else
If
InStr(start, suchtext, suchzeichen) = 0
Then
pos_in_text = 0
Exit
Function
Else
pos_in_text = InStr(start, suchtext, suchzeichen) + Len(suchzeichen)
End
If
End
If
End
Function
Sub
klickmich()
Dim
stext
As
String
Dim
stmp
As
Variant
, stxt, sresult
As
String
Dim
i&
stext =
"Body-name:;chairman-name:;members-all:"
stmp = Split(stext,
";"
)
For
i = 0
To
UBound(stmp)
stxt = Split(stmp(i),
"-"
)
sresult = getnextuser(stxt(0), stxt(1))
If
InStr(1, sresult,
""
""
) > 0
Then
Range(
"B3"
).Offset(, i) = Split(getnextuser(stxt(0), stxt(1)),
""
""
)(1)
End
If
Next
End
Sub