Ord mellem to ord

who enters 'mit navn'?

Hej.

Jeg kender ikke en kommando der kan det, men med InStr kan du konstruere noget der kan.

InStr søger fra en strengs begyndelse - eller fra en position du selv angiver - efter den første forekomst af en anden streng.  InStr returnerer positionen for 1. tegn i den streng du søger efter.

M.v.h.  Jørn

Here is a good start, copy ity into a module (BAS)

'* String Functions
'*
'* See the subroutine "examples" to test the supplied functions.
Option Compare Database
Option Explicit

Sub example_of_parsing()
'* This is an example of how to parse a sentence into individual words.
'* Press F5 to run this code
Dim i As Integer
Dim s As String
Dim sWord As String
i = 1
s = "This is the new house next door."  '<< Put the sentence here.
sWord = xg_GetSubString(s, i, " ")
Do While sWord <> ""
    MsgBox sWord
    i = i + 1
    sWord = xg_GetSubString(s, i, " ")
Loop
End Sub

Sub examples()
'* Example of the functions in this module
'*
'* To test the functions, un-comment the line, and click the go/continue button (or press f5)

Dim MyField As String
MyField = "123456789"

'MsgBox xg_GetWordsBetween("The Lazy Fox", "The", "Fox")
'MsgBox xg_GetLastWord("The Lazy Fox") '* Get last word in sentence
'MsgBox xg_GetSubString("The Lazy Fox", 2, " ") '* Get second substring, " " is delimiter
'MsgBox xg_GetSubString("a;b;c;d;e;f;g;h", 4, ";") '* Get 4th substring, ";" is delimiter
'MsgBox xg_ReplaceAllWith("The Lazy Fox is crazed", "az", "onel") '* Replace "az" with "onel"
'MsgBox xg_lPad(MyField, "0", 10)  '* Left pad with 0 to length of 10 chars
'MsgBox xg_RPad(MyField, "x", 12)  '* Right pad with "x" to length of 12 chars

End Sub


Function xg_lPad(sStringToPad As String, sPadChar As String, iTotalDesiredLengthOfString As Integer) As String
'* Pads characters on the left of a string out to a desired total string length
'* Returns the padded string
xg_lPad = xg_Repeat(sPadChar, iTotalDesiredLengthOfString - Len(Trim(sStringToPad))) & Trim(sStringToPad)
End Function
Function xg_RPad(sStringToPad As String, sPadChar As String, iTotalDesiredLengthOfString As Integer) As String
Dim i As Integer
Dim sFill As String
sFill = ""
If Len(sStringToPad) < iTotalDesiredLengthOfString Then
    For i = 1 To (iTotalDesiredLengthOfString - Len(sStringToPad))
        sFill = sFill & sPadChar
    Next i
End If
xg_RPad = sStringToPad & sFill
End Function

Function xg_Repeat(sStringToRepeat As String, iNumOfTimes As Integer) As String
Dim i As Integer
Dim s As String
s = ""
For i = 1 To iNumOfTimes
    s = s & sStringToRepeat
Next i
xg_Repeat = s
End Function

Function xg_ReplaceAllWith(sMainString As String, _
sSubString As String, sReplaceString As String) As String
'* Recursive function to replace all occurences of sSubString
'* with sReplaceString in sMainString
Dim i As Integer
Dim ipos As Integer
Dim s As String
Dim s1 As String, s2 As String

s = sMainString
ipos = InStr(1, sMainString, sSubString)
If ipos = 0 Then
    GoTo Exit_xg_ReplaceAllWith
End If
s1 = Mid(sMainString, 1, ipos - 1)
s2 = Mid(sMainString, ipos + Len(sSubString), Len(sMainString))
s = s1 & sReplaceString & _
    xg_ReplaceAllWith(s2, sSubString, sReplaceString)

Exit_xg_ReplaceAllWith:
    xg_ReplaceAllWith = s
End Function







Function xg_GetWordsBetween(sMain As String, s1 As String, s2 As String) As String
'* Returns a trimmed substring of the string 'sMain' that lies between substrings s1 and s2
'* Ex.: xg_GetWordsBetween("The Lazy Fox", "The", "Fox") returns "Lazy".
On Error Resume Next
Dim iStart As Integer, iEnd As Integer
    iStart = InStr(1, sMain, s1) + Len(s1)
    iEnd = InStr(iStart, sMain, s2)
    xg_GetWordsBetween = Trim(Mid(sMain, iStart, iEnd - iStart))
End Function







Function xg_GetLastWord(sStr As String) As String
'* Returns the last word in sStr
Dim i As Integer
Dim ilen As Integer
Dim s As String
Dim stemp As String
Dim sLastWord As String
Dim sHold As String
Dim iFoundChar As Integer

stemp = ""
sLastWord = ""
iFoundChar = False
sHold = sStr
ilen = Len(sStr)
For i = ilen To 1 Step -1
    s = Right(sHold, 1)
    If s = " " Then
        If Not iFoundChar Then
            '* skip spaces at end of string.
        Else
            sLastWord = stemp
            Exit For
        End If
    Else
        iFoundChar = True
        stemp = s & stemp
    End If
    If Len(sHold) > 0 Then
        sHold = Left(sHold, Len(sHold) - 1)
    End If
Next i

If sLastWord = "" And stemp <> "" Then
    sLastWord = stemp
End If
'MsgBox "lastword =" & Trim(sLastWord)
xg_GetLastWord = Trim(sLastWord)
End Function






Function xg_GetSubString(mainstr As String, n As Integer, delimiter As String) As String
'* Get the "n"-th substring from "mainstr" where strings are delimited by "delimiter"
    Dim i As Integer
    Dim substringcount As Integer
    Dim pos As Integer
    Dim strx As String
    Dim val1 As Integer
    Dim w As String

On Error GoTo Err_xg_GetSubString

w = ""
substringcount = 0
i = 1
pos = InStr(i, mainstr, delimiter)
Do While pos <> 0
    strx = Mid(mainstr, i, pos - i)
    substringcount = substringcount + 1
    If substringcount = n Then
        Exit Do
    End If
    i = pos + 1
    pos = InStr(i, mainstr, delimiter)
Loop

If substringcount = n Then
    xg_GetSubString = strx
Else
    strx = Mid(mainstr, i, Len(mainstr) + 1 - i)
    substringcount = substringcount + 1
    If substringcount = n Then
        xg_GetSubString = strx
    Else
        xg_GetSubString = ""
    End If
End If

Exit Function

Err_xg_GetSubString:
    MsgBox "xg_GetSubString " & Err & " " & Err.Description
    Resume Next

End Function

Ja, det var nemlig også det jeg tænkte på, men nu havde jeg oprettet spm'et, så jeg ville lige høre. Men jeg lukker mit spm, for jeg er selv ved at kontruere en funktion. Skriver den senere. Men tak for interessen til jer begge !!

Terry: Too long code. Well, you get 30 point, for your trying!

Ved ikke om man kan kigge "macroerne" i word altså de indbyggede, for der ligger der noget hvor du kan lave det.......

Jeg skulle f.eks. engang skrive en opgave omkring Black Sabbath, der oprettede jeg BS og hver gang jeg skrev bs skiftede word det ud med Black Sabbath........

Er det sådan noget du leder efter.....

There are a a number of string functions which may be able to help you !

tak :o)

Nåh, men jeg synes alligevel i skal se hvad jeg har fået ud af det. Her kommer det:

Public Function GetString(fString As String, fText1 As String, fText2 As String) As String

  'Kontrollere om fText1 & fText2 eksistere
  If InStr(LCase(fString), LCase(fText1)) <> 0 And InStr(LCase(fString), LCase(fText2)) <> 0 Then
   
    'Kontrollere om fText2 kommer før fText1
    If InStr(LCase(fString), LCase(fText2)) > InStr(LCase(fString), LCase(fText1)) Then
      fstartpoint = InStr(LCase(fString), LCase(fText1)) + Len(fText1)
      fendpoint = InStr(LCase(fString), LCase(fText2))
      GetString = Mid(fString, fstartpoint, fendpoint - fstartpoint)
      Exit Function
    End If
 
  End If

End Function