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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.