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 © 2025 vBulletin Solutions Inc. All rights reserved.