PDA

View Full Version : InStr() Option



heedaf
07-14-2017, 10:39 AM
Does anyone know if there is another function like InStr() where it will return the position location of everything found in a string?

str = "abcabcabcabc"

val = instr***(str, "b")

'returns 2,5,8,11

I know I can create my own but I was wondering if anyone new a function that already exists that can do this.

gmaxey
07-14-2017, 12:23 PM
I can't speak for the other 6 + billion souls but AFAIK there is no built-in function that does that. I have my own custom function for that purpose. It will be interesting to see yours.

heedaf
07-14-2017, 12:57 PM
I figured as such but I thought I'd give it a shot. Would be nice though.

gmaxey
07-14-2017, 04:33 PM
Unless you just want me to give you a fish, post what you come up with and we can compare.

fanjy
06-29-2019, 05:49 AM
try:

Function InstrSample4(str1 As String, str2 As String) As Long()
Dim iPos As Long
Dim iPos1 As Long
Dim iPosAll() As Long
Dim iCount As Long

iPos = InStr(1, str1, str2)
iPos1 = iPos
Do While (iPos <> 0)
iCount = iCount + 1
ReDim Preserve iPosAll(1 To iCount)
iPosAll(iCount) = iPos1
str1 = Mid(str1, iPos + Len(str2))
iPos = InStr(1, str1, str2)
iPos1 = iPos1 + Len(str2) + iPos - 1
Loop

InstrSample4 = iPosAll()
End Function



Sub test()
Dim str As String
str = "abcabcabcabc"
Dim val
val = InstrSample4(str, "b")
Dim i As Long
For i = LBound(val) To UBound(val)
Debug.Print val(i)
Next
End Sub

gmaxey
06-29-2019, 01:30 PM
fanjy,

Yes, that is one way. Here is another:


Sub TestFunction()
Dim strSample As String
Dim lngIndex As Long
Dim varRtn
strSample = "abcabcabcabc"
varRtn = fcnGetSubStringPosits(strSample, "b")
If Not IsArrayEmpty(varRtn) Then
For lngIndex = LBound(varRtn) To UBound(varRtn)
Debug.Print varRtn(lngIndex)
Next lngIndex
End If
lbl_Exit:
Exit Sub
End Sub


Function fcnGetSubStringPosits(strMain As String, strSub As String) As Long()
Dim arrParts() As String
Dim arrPosits() As Long
Dim lngIndex As Long, lngCalc As Long
arrParts = Split(strMain, strSub)
For lngIndex = 0 To UBound(arrParts) - 1
ReDim Preserve arrPosits(lngIndex)
arrPosits(lngIndex) = Len(arrParts(lngIndex)) + 1 + lngCalc
lngCalc = lngCalc + Len(arrParts(lngIndex)) + Len(strSub)
Next lngIndex
fcnGetSubStringPosits = arrPosits
lbl_Exit:
Exit Function
End Function


Public Function IsArrayEmpty(varArray As Variant) As Boolean
Dim lngLB As Long, lngUB As Long
If Not IsArray(varArray) Then
IsArrayEmpty = True
Exit Function
End If
On Error Resume Next
lngUB = UBound(varArray, 1)
If (Err.Number <> 0) Then
IsArrayEmpty = True
Else
Err.Clear
IsArrayEmpty = False
lngLB = LBound(varArray)
If lngLB > lngUB Then IsArrayEmpty = True
End If
lngLBl_Exit:
Exit Function
End Function

PeterH_NZ
06-30-2019, 07:49 PM
Just for diversity, I'd do it this way:



Public Sub FindPositionsTest()
Const c_testData As String = "abcdefabcdefaaabbbcccdddeeefffa"
Const c_findIt As String = "bc"

Dim arrayMax As Long
Dim foundAt As Long
Dim positions() As Long
Dim theIndex As Long

' There must be something to find and search
If LenB(c_findIt) = 0 Or LenB(c_testData) = 0 Then
Exit Sub
End If

' Allocate the maximum # of possible find slots
arrayMax = Len(c_testData) \ Len(c_findIt)
ReDim positions(1 To arrayMax)

' Standard find something in something
For theIndex = 1 To arrayMax

' Find what were looking for
foundAt = InStr(foundAt + 1, c_testData, c_findIt)
If foundAt = 0 Then

' Only return those array elements that were assigned values
If theIndex > 1 Then
ReDim Preserve positions(1 To theIndex - 1)
Else
' Do this so that LBound/UBound dont fail
ReDim positions(-1 To -1)
End If

Exit For
Else

' Stash the value
positions(theIndex) = foundAt
End If
Next

' Dump what we found
If UBound(positions) > 0 Then
For theIndex = 1 To UBound(positions)
Debug.Print positions(theIndex)
Next
End If
End Sub

yujin
07-08-2019, 07:59 PM
Hi, everyone. Here's the code using regular expression.



Sub test()
Dim Match, Matches
Dim strPattern As String
Dim strTest As String


strTest = "abcabcabcabcabc"
strPattern = "ca"

With CreateObject("VBScript.RegExp")
.Pattern = strPattern
.IgnoreCase = True
.Global = True
Set Matches = .Execute(strTest)
End With

For Each Match In Matches
Debug.Print Match.FirstIndex + 1
Next
End Sub