Funkcja: Replace_RegExp2   strona główna:
A po co ten Excel ;-)
 
 
  poprzedni temat:
Dziś "kotlet trochu odgrzewany" ale wg mnie funkcja zasługuje na wyodrębnienie z poprzedniego tematu.   Import danych z Arkuszy Kaluklacyjnych Google.
Google API dot. Google SpreadSheets i interpretacja zwracaych przez Query.setResponse wyników.
 
    Na tą chwilę nie wiem jak inaczej do sprawy podejść - w bardziej elegancki sposób - samą Metodą Replace.  
Chciałbym zastępować określonym znakiem każde dopasowanie w ciągu jednak ilość wstawianych znaków ma być uzalezniona  
od długości dopasowanego ciągu - "znak za znak".
 
Problem najlepiej przedstawić na przykładzie  
v2 to Replace_RegExp2  
v1 to Replace_RegExp  
w przykładzie pierwszym - "kazda cyfra" - nie ma róznicy  
ale w przykładzie drugim: "przynajmniej dwie cyfry"  
różnica między wynikami wskazuje na omawiany problem  
Ja chcę zastąpić każdą cyfrę znakiem # jeżeli obok siebie wystąpiły przynajmniej dwie cyfry :-)  
 
Function Replace_RegExp2(strText As String, _  
                         strFind As String, _  
                         Optional vReplace As Variant = vbNullString) As String  
      
    On Error GoTo Replace_RegExp_Error  
 
    Dim objRegExp As Object 'VBScript.RegExp  
    Dim colMatches As Object, objMatch As Object  
    Dim newStr As String  
      
    Set objRegExp = VBA.CreateObject("VBScript.RegExp")  
    With objRegExp  
        .Global = True  
        .Pattern = strFind  
        If .Test(strText) Then  
            Set colMatches = objRegExp.Execute(strText)  
            For Each objMatch In colMatches  
                With objMatch  
                    newStr = Left(strText, .FirstIndex) & _  
                             String(.Length, vReplace) & _  
                             Right(strText, Len(strText) - .FirstIndex - .Length)  
                    strText = newStr  
                    'Debug.Print strText  
                End With  
            Next  
            Replace_RegExp2 = newStr  
        Else  
            Replace_RegExp2 = strText  
        End If  
    End With  
      
Replace_RegExp_Exit:  
    Set objMatch = Nothing  
    Set colMatches = Nothing  
    Set objRegExp = Nothing  
    Exit Function  
      
Replace_RegExp_Error:  
    Replace_RegExp2 = strText  
    Resume Replace_RegExp_Exit  
End Function  
 
Funkcjarealizująca zadanie tak naprawdę nie korzysta z Metody Replace obj. RegExp.  
Wykomentowana linia zwracająca dane do okna
 
Immediate pomoże mi wyjaśnić działanie funkcji  
Jeżeli Metoda Test potwierdzi że są dopasowania  
w ciągu, tworzę kolekcję dopasowań i zmieniam  
każde dopasowanie z osobna.