ABOUT Visual Basic Programmieren Programmierung Download Downloads Tips & Tricks Tipps & Tricks Know-How Praxis VB VBA Visual Basic for Applications VBS VBScript Scripting Windows ActiveX COM OLE API ComputerPC Microsoft Office Microsoft Office 97 Office 2000 Access Word Winword Excel Outlook Addins ASP Active Server Pages COMAddIns ActiveX-Controls OCX UserControl UserDocument Komponenten DLL EXE
Diese Seite wurde zuletzt aktualisiert am 30.04.2001

Diese Seite wurde zuletzt aktualisiert am 30.04.2001
Aktuell im ABOUT Visual Basic-MagazinGrundlagenwissen und TechnologienKnow How, Tipps und Tricks rund um Visual BasicActiveX-Komponenten, Controls, Klassen und mehr...AddIns für die Visual Basic-IDE und die VBA-IDEVBA-Programmierung in MS-Office und anderen AnwendungenScripting-Praxis für den Windows Scripting Host und das Scripting-ControlTools, Komponenten und Dienstleistungen des MarktesRessourcen für Programmierer (Bücher, Job-Börse)Dies&Das...

Themen und Stichwörter im ABOUT Visual Basic-Magazin
Code, Beispiele, Komponenten, Tools im Überblick, Shareware, Freeware
Ihre Service-Seite, Termine, Job-Börse
Melden Sie sich an, um in den vollen Genuss des ABOUT Visual Basic-Magazins zu kommen!
Informationen zum ABOUT Visual Basic-Magazin, Kontakt und Impressum

Zurück...

Tauschgeschäfte

Zurück...


Anzeige

(-hg) mailto:hg_replaceex@aboutvb.de

Seit Visual Basic 6 steht Ihnen die Funktion Replace zur Verfügung, die die Vorkommen eines Strings in einem gegebenen String gegen einen anderen austauschen kann. In Visual Basic 5 steht diese Funktion noch nicht zur Verfügung. Die folgende Ersatz-Funktion bietet die gleiche Funktionalität wie ihr VB 6-Original:

Public Enum rxCompareMethodConstants
  rxCompareBinary
  rxCompareText
End Enum

Public Function Replace(ByVal Expression As String, Find As String, _
 ReplaceBy As String, Optional ByVal Start As Long = 1, _
 Optional ByVal Count As Long = -1, Optional ByVal CompareMethod _
 As rxCompareMethodConstants = rxCompareBinary) As String

  Dim nCount As Long
  Dim nPos As Long
  Dim nLenReplaceBy As Long

  nLenReplaceBy = Len(ReplaceBy)
  If Start > 1 Then
    Replace = Left$(Expression, Start - 1)
  End If
  Do
    nPos = InStr(Start, Expression, Find, CompareMethod)
    If nPos Then
      Replace = Replace & Mid$(Expression, Start, nPos - Start) _
       & ReplaceBy
      Start = nPos + nLenReplaceBy
    Else
      Replace = Replace & Mid$(Expression, Start)
      Exit Do
    End If
    nCount = nCount + 1
    If nCount = Count Then
      Replace = Replace & Mid$(Expression, Start)
      Exit Do
    End If
  Loop
End Function

Im ersten Parameter übergeben Sie den String, in dem Teile ersetzt werden sollen, Im zweiten und dritten Parameter folgen der zu ersetzende String und die Ersetzung. Im optionalen Parameter Start können Sie die Position angeben, ab der die Ersetzungen erfolgen sollen. In Count können sie festlegen, wie oft die Ersetzung erfolgen soll (Voreinstellung -1, es werden alle Vorkommen ersetzt). Im letzten optionalen Parameter CompareMethod geben Sie an, ob nur exakte Vorkommen ersetzt werden sollen (rxCompareBinary, Voreinstellung) oder ob die Ersetzungen unabhängig von der Groß-/Kleinschreibung der Vorkommen erfolgen sollen (rxCompareText).

Eine Erweiterung der Replace-Funktion, die auch in Visual Basic 6 noch nicht vorhanden ist, wäre die Möglichkeit, gleich mehrere Ersetzungen in einem Aufruf vornehmen zu können - etwa alle "b" durch "p" und zugleich alle "d" durch "t". diese Möglichkeit bietet die Funktion ReplaceStack. Hier geben Sie die zu ersetzenden Zeichen zusammengefasst im Parameter StackFrom (z.B. "bd") und die jeweils entsprechenden Ersetzungen zusammengefasst (z.B. "pt") im Parameter StackTo an. Ist die Anzahl der Zeichen in StackFrom höher als in StackTo, können Sie im optionalen Parameter StripMissingTo mit True festlegen, dass die Vorkommen der überzähligen Zeichen in StackFrom gelöscht werden. Ist die Anzahl der Zeichen in StackFrom geringer als in StackTo, werden nur die vorhandenen Zeichen aus StackFrom ersetzt. Die Bedeutungen der übrigen Parameter Start, Count und CompareMethod sind die gleichen wie bei der Replace-Funktion.

Public Enum rxCompareMethodConstants
  rxCompareBinary
  rxCompareText
End Enum

Public Function ReplaceStack(ByVal Expression As String, _
 ByVal StackFrom As String, ByVal StackTo As String, _
 Optional ByVal Start As Long = 1, _
 Optional ByVal Count As Long = -1, _
 Optional ByVal CompareMethod As rxCompareMethodConstants _
 = rxCompareBinary, Optional ByVal StripMissingTo As Boolean) _
 As String

  Dim l As Long
  Dim nMax As Long
  
  Select Case StripMissingTo
    Case True
      If Len(StackFrom) > Len(StackTo) Then
        For l = 1 To Len(StackTo)
          Expression = Replace(Expression, Mid$(StackFrom, l, 1), _
           Mid$(StackTo, l, 1), Start, Count, CompareMethod)
        Next 'l
        For l = Len(StackTo) + 1 To Len(StackFrom)
          Expression = Replace(Expression, Mid$(StackFrom, l, 1), _
           "", Start, Count, CompareMethod)
        Next 'l
      Else
        For l = 1 To Len(StackFrom)
          Expression = Replace(Expression, Mid$(StackFrom, l, 1), _
           Mid$(StackTo, l, 1), Start, Count, CompareMethod)
        Next 'l
      End If
    Case False
      If Len(StackTo) > Len(StackFrom) Then
        nMax = Len(StackFrom)
      Else
        nMax = Len(StackTo)
      End If
      For l = 1 To nMax
        Expression = Replace(Expression, Mid$(StackFrom, l, 1), _
         Mid$(StackTo, l, 1), Start, Count, CompareMethod)
      Next 'l
  End Select
  ReplaceStack = Expression
End Function

Es ist offensichtlich, dass diese Stapelersetzung nur mit einzelnen Zeichen funktionieren kann. Wenn Sie dagegen Strings beliebiger Länge gegen Strings ebenfalls beliebiger Länge austauschen möchten, müssen die beiden Stapel als Array oder als Collection übergeben werden. Dazu sind die folgenden Funktionen gedacht. An ReplaceStackArr können sie jeweils String-Arrays übergeben, an ReplaceStackColl können Sie Collections (nur VB-Standard-Collections) übergeben. An ReplaceStackObj können Sie beliebige Collections übergeben, soweit diese über eine Count-Eigenschaft verfügen und deren Standard-Eigenschaft die jeweiligen Elemente über eine nummerische Index-Angabe zur Verfügung stellt. Sie können diese Funktion aber auch leicht an spezifische Collections anpassen, falls die Eigenschaft zur Ermittlung der Anzahl der Elemente anders lauten sollte, oder falls keine Standard-Eigenschaft vorhanden sein sollte. Für alle drei Funktionen gilt natürlich, dass sich die einzelnen Elemente in Strings konvertieren lassen.

Die Funktion ReplaceStackVar bietet die größte Flexibilität. Hier können Sie sowohl in StackFrom als auch in StackTo beliebige Arrays, Collections und auch Einzel-Strings (wie in der Standard-Variante ReplaceStack) übergeben - sogar in beliebigen Kombinationen.

Für die Funktionen ReplaceStackArr und ReplaceStackVar gilt, dass die Untergrenze eines Array in StackFrom festlegt, mit welchem Element in StackTo begonnen wird. Ist etwa die Untergrenze von StackFrom 3 und in StackTo 1, wird das erste Element von StackFrom gegen das dritte Element von Stack To, das zweite Element von StackFrom gegen das vierte Element von StackTo usw. ausgetauscht. Bei überzähligen Elementen in StackFrom gilt wie bei der Standard-Version ReplaceStack, dass der optionale Parameter StripMissingTo festlegt, ob diese gelöscht werden oder unberücksichtig bleiben.

Public Function ReplaceStack(ByVal Expression As String, _
 ByVal StackFrom As String, ByVal StackTo As String, _
 Optional ByVal Start As Long = 1, _
 Optional ByVal Count As Long = -1, _
 Optional ByVal CompareMethod As rxCompareMethodConstants _
 = rxCompareBinary, Optional ByVal StripMissingTo As Boolean) _
 As String

  Dim l As Long
  Dim nMax As Long
  
  Select Case StripMissingTo
    Case True
      If Len(StackFrom) > Len(StackTo) Then
        For l = 1 To Len(StackTo)
          Expression = Replace(Expression, Mid$(StackFrom, l, 1), _
           Mid$(StackTo, l, 1), Start, Count, CompareMethod)
        Next 'l
        For l = Len(StackTo) + 1 To Len(StackFrom)
          Expression = Replace(Expression, Mid$(StackFrom, l, 1), _
           "", Start, Count, CompareMethod)
        Next 'l
      Else
        For l = 1 To Len(StackFrom)
          Expression = Replace(Expression, Mid$(StackFrom, l, 1), _
           Mid$(StackTo, l, 1), Start, Count, CompareMethod)
        Next 'l
      End If
    Case False
      If Len(StackTo) > Len(StackFrom) Then
        nMax = Len(StackFrom)
      Else
        nMax = Len(StackTo)
      End If
      For l = 1 To nMax
        Expression = Replace(Expression, Mid$(StackFrom, l, 1), _
         Mid$(StackTo, l, 1), Start, Count, CompareMethod)
      Next 'l
  End Select
  ReplaceStack = Expression
End Function

Public Function ReplaceStackArr(ByVal Expression As String, _
 StackFrom() As String, StackTo() As String, _
 Optional ByVal Start As Long = 1, _
 Optional ByVal Count As Long = -1, _
 Optional ByVal CompareMethod As rxCompareMethodConstants _
 = rxCompareBinary, Optional ByVal StripMissingTo As Boolean) _
 As String

  Dim l As Long
  Dim nMax As Long
  
  Select Case StripMissingTo
    Case True
      If UBound(StackFrom) > UBound(StackTo) Then
        For l = LBound(StackFrom) To UBound(StackTo)
          Expression = Replace(Expression, StackFrom(l), _
           StackTo(l), Start, Count, CompareMethod)
        Next 'l
        For l = UBound(StackTo) + 1 To UBound(StackFrom)
          Expression = Replace(Expression, StackFrom(l), _
           "", Start, Count, CompareMethod)
        Next 'l
      Else
        For l = LBound(StackFrom) To UBound(StackFrom)
          Expression = Replace(Expression, StackFrom(l), _
           StackTo(l), Start, Count, CompareMethod)
        Next 'l
      End If
    Case False
      If UBound(StackTo) > UBound(StackFrom) Then
        nMax = UBound(StackFrom)
      Else
        nMax = UBound(StackTo)
      End If
      For l = 1 To nMax
        Expression = Replace(Expression, StackFrom(l), StackTo(l), _
         Start, Count, CompareMethod)
      Next 'l
  End Select
  ReplaceStackArr = Expression
End Function

Public Function ReplaceStackColl(ByVal Expression As String, _
 StackFrom As Collection, StackTo As Collection, _
 Optional ByVal Start As Long = 1, _
 Optional ByVal Count As Long = -1, _
 Optional ByVal CompareMethod As rxCompareMethodConstants _
 = rxCompareBinary, Optional ByVal StripMissingTo As Boolean) _
 As String

  Dim l As Long
  Dim nMax As Long
  
  Select Case StripMissingTo
    Case True
      If StackFrom.Count > StackTo.Count Then
        For l = 1 To StackTo.Count
          Expression = Replace(Expression, CStr(StackFrom(l)), _
           CStr(StackTo(l)), Start, Count, CompareMethod)
        Next 'l
        For l = StackTo.Count + 1 To StackFrom.Count
          Expression = Replace(Expression, CStr(StackFrom(l)), _
           "", Start, Count, CompareMethod)
        Next 'l
      Else
        For l = 1 To StackFrom.Count
          Expression = Replace(Expression, CStr(StackFrom(l)), _
           CStr(StackTo(l)), Start, Count, CompareMethod)
        Next 'l
      End If
    Case False
      If StackTo.Count > StackFrom.Count Then
        nMax = StackFrom.Count
      Else
        nMax = StackTo.Count
      End If
      For l = 1 To nMax
        Expression = Replace(Expression, CStr(StackFrom(l)), _
         CStr(StackTo(l)), Start, Count, CompareMethod)
      Next 'l
  End Select
  ReplaceStackColl = Expression
End Function

Public Function ReplaceStackObj(ByVal Expression As String, _
 StackFrom As Object, StackTo As Object, _
 Optional ByVal Start As Long = 1, _
 Optional ByVal Count As Long = -1, _
 Optional ByVal CompareMethod As rxCompareMethodConstants _
 = rxCompareBinary, Optional ByVal StripMissingTo As Boolean) _
 As String

  Dim l As Long
  Dim nMax As Long
  
  Select Case StripMissingTo
    Case True
      If StackFrom.Count > StackTo.Count Then
        For l = 1 To StackTo.Count
          Expression = Replace(Expression, CStr(StackFrom(l)), _
           CStr(StackTo(l)), Start, Count, CompareMethod)
        Next 'l
        For l = StackTo.Count + 1 To StackFrom.Count
          Expression = Replace(Expression, CStr(StackFrom(l)), _
           "", Start, Count, CompareMethod)
        Next 'l
      Else
        For l = 1 To StackFrom.Count
          Expression = Replace(Expression, CStr(StackFrom(l)), _
           CStr(StackTo(l)), Start, Count, CompareMethod)
        Next 'l
      End If
    Case False
      If StackTo.Count > StackFrom.Count Then
        nMax = StackFrom.Count
      Else
        nMax = StackTo.Count
      End If
      For l = 1 To nMax
        Expression = Replace(Expression, CStr(StackFrom(l)), _
         CStr(StackTo(l)), Start, Count, CompareMethod)
      Next 'l
  End Select
  ReplaceStackObj = Expression
End Function

Public Function ReplaceStackVar(ByVal Expression As String, _
 StackFrom As Variant, StackTo As Variant, _
 Optional ByVal Start As Long = 1, _
 Optional ByVal Count As Long = -1, _
 Optional ByVal CompareMethod As rxCompareMethodConstants _
 = rxCompareBinary, Optional ByVal StripMissingTo As Boolean) _
 As String

  Dim l As Long
  Dim nMax As Long
  Dim nLBoundFrom As Long
  Dim nLBoundTo As Long
  Dim nUBoundFrom As Long
  Dim nUBoundTo As Long
  Dim nFromIsString As Boolean
  Dim nToIsString As Boolean
  Dim nString As String
  Dim nArray() As String
  
  If IsObject(StackFrom) Then
    nLBoundFrom = 1
    nUBoundFrom = StackFrom.Count
  ElseIf IsArray(StackFrom) Then
    nLBoundFrom = LBound(StackFrom)
    nUBoundFrom = UBound(StackFrom)
  ElseIf VarType(StackFrom) = vbString Then
    nFromIsString = True
  End If
  If IsObject(StackTo) Then
    nLBoundTo = 1
    nUBoundTo = StackTo.Count
  ElseIf IsArray(StackTo) Then
    nLBoundTo = LBound(StackTo)
    nUBoundTo = UBound(StackTo)
  ElseIf VarType(StackTo) = vbString Then
    nToIsString = True
  End If
  Select Case True
    Case nFromIsString And nToIsString
      ReplaceStackVar = ReplaceStack(Expression, CStr(StackFrom), _
       CStr(StackTo), CompareMethod, StripMissingTo)
      Exit Function
    Case nFromIsString
      nString = StackFrom
      If IsObject(StackTo) Then
        nLBoundFrom = 1
        nUBoundFrom = Len(nString)
      ElseIf IsArray(StackTo) Then
        nLBoundFrom = nLBoundTo
        nUBoundFrom = nLBoundTo + Len(nString) - 1
      End If
      ReDim nArray(nLBoundFrom To nUBoundFrom)
      For l = nLBoundFrom To nUBoundFrom
        nArray(l) = Mid$(nString, l - nLBoundFrom + 1, 1)
      Next 'l
      StackFrom = nArray
    Case nToIsString
      nString = StackTo
      If IsObject(StackFrom) Then
        nLBoundTo = 1
        nUBoundTo = Len(nString)
      ElseIf IsArray(StackFrom) Then
        nLBoundTo = nLBoundFrom
        nUBoundTo = nLBoundFrom + Len(nString) - 1
      End If
      ReDim nArray(nLBoundTo To nUBoundTo)
      For l = nLBoundTo To nUBoundTo
        nArray(l) = Mid$(nString, l - nLBoundTo + 1, 1)
      Next 'l
      StackTo = nArray
  End Select
  Select Case StripMissingTo
    Case True
      If nUBoundFrom > nUBoundTo Then
        For l = nLBoundFrom To nUBoundTo
          Expression = Replace(Expression, CStr(StackFrom(l)), _
           CStr(StackTo(l)), Start, Count, CompareMethod)
        Next 'l
        For l = nUBoundTo + 1 To nUBoundTo
          Expression = Replace(Expression, CStr(StackFrom(l)), _
           "", Start, Count, CompareMethod)
        Next 'l
      Else
        For l = nLBoundFrom To nUBoundFrom
          Expression = Replace(Expression, CStr(StackFrom(l)), _
           CStr(StackTo(l)), Start, Count, CompareMethod)
        Next 'l
      End If
    Case False
      If nUBoundTo > nUBoundFrom Then
        nMax = nUBoundFrom
      Else
        nMax = nUBoundTo
      End If
      For l = nLBoundFrom To nMax
        Expression = Replace(Expression, CStr(StackFrom(l)), _
         CStr(StackTo(l)), Start, Count, CompareMethod)
      Next 'l
  End Select
  ReplaceStackVar = Expression
End Function

Eine weitere Variante für Ersetzungen stellt das direkte Vertauschen der Vorkommen von zwei Zeichen bzw. Strings dar. Sie können das natürlich wie beim gewöhnlich Vertauschen der Inhalte von Variablen in drei Schritten nacheinander wiederholt mit der Replace-Funktion erledigen. Diese einfache Form erledigt die folgende Funktion ReplaceSwap in einem Durchgang.

Public Function ReplaceSwap(Expression As String, _
 SwapFrom As String, SwapTo As String, _
 Optional ByVal Start As Long = 1, _
 Optional ByVal Count As Long = -1, _
 Optional ByVal CompareMethod As rxCompareMethodConstants _
 = rxCompareBinary, Optional Swap As String) As String

  Dim nSwap As String
  
  If StrPtr(Swap) = 0 Then
    nSwap = Chr$(1)
  Else
    nSwap = Swap
  End If
  ReplaceSwap = Replace(Expression, SwapTo, nSwap, Start, _
   Count, CompareMethod)
  ReplaceSwap = Replace(ReplaceSwap, SwapFrom, SwapTo, Start, _
   Count, CompareMethod)
  ReplaceSwap = Replace(ReplaceSwap, nSwap, SwapFrom, Start, _
   Count, CompareMethod)
End Function

Der dreimalige Aufruf der Stack-Varianten wäre jedoch etwas unsinnig und zeitraubend. Darum finden Sie nun im folgenden noch die entsprechenden Varianten ReplaceSwapStack, ReplaceSwapStackArr, ReplaceSwapStackColl, ReplaceSwapStackObj und ReplaceSwapStackVar, die intern statt Replace die Variante ReplaceSwap direkt verwenden.

Public Function ReplaceSwapStack(ByVal Expression As String, _
 ByVal StackFrom As String, ByVal StackTo As String, _
 Optional ByVal Start As Long = 1, _
 Optional ByVal Count As Long = -1, _
 Optional ByVal CompareMethod As rxCompareMethodConstants _
 = rxCompareBinary, Optional ByVal StripMissingTo As Boolean) _
 As String

  Dim l As Long
  Dim nMax As Long
  
  Select Case StripMissingTo
    Case True
      If Len(StackFrom) > Len(StackTo) Then
        For l = 1 To Len(StackTo)
          Expression = ReplaceSwap(Expression, _
           Mid$(StackFrom, l, 1), Mid$(StackTo, l, 1), Start, _
           Count, CompareMethod)
        Next 'l
        For l = Len(StackTo) + 1 To Len(StackFrom)
          Expression = ReplaceSwap(Expression, _
           Mid$(StackFrom, l, 1), "", Start, Count, CompareMethod)
        Next 'l
      Else
        For l = 1 To Len(StackFrom)
          Expression = ReplaceSwap(Expression, _
           Mid$(StackFrom, l, 1), Mid$(StackTo, l, 1), Start, _
           Count, CompareMethod)
        Next 'l
      End If
    Case False
      If Len(StackTo) > Len(StackFrom) Then
        nMax = Len(StackFrom)
      Else
        nMax = Len(StackTo)
      End If
      For l = 1 To nMax
        Expression = ReplaceSwap(Expression, _
         Mid$(StackFrom, l, 1), Mid$(StackTo, l, 1), Start, _
         Count, CompareMethod)
      Next 'l
  End Select
  ReplaceSwapStack = Expression
End Function

Public Function ReplaceSwapStackArr(ByVal Expression As String, _
 StackFrom() As String, StackTo() As String, _
 Optional ByVal Start As Long = 1, _
 Optional ByVal Count As Long = -1, _
 Optional ByVal CompareMethod As rxCompareMethodConstants _
 = rxCompareBinary, Optional ByVal StripMissingTo As Boolean) _
 As String

  Dim l As Long
  Dim nMax As Long
  
  Select Case StripMissingTo
    Case True
      If UBound(StackFrom) > UBound(StackTo) Then
        For l = LBound(StackFrom) To UBound(StackTo)
          Expression = ReplaceSwap(Expression, StackFrom(l), _
           StackTo(l), Start, Count, CompareMethod)
        Next 'l
        For l = UBound(StackTo) + 1 To UBound(StackFrom)
          Expression = ReplaceSwap(Expression, StackFrom(l), "", _
           Start, Count, CompareMethod)
        Next 'l
      Else
        For l = LBound(StackFrom) To UBound(StackFrom)
          Expression = ReplaceSwap(Expression, StackFrom(l), _
           StackTo(l), Start, Count, CompareMethod)
        Next 'l
      End If
    Case False
      If UBound(StackTo) > UBound(StackFrom) Then
        nMax = UBound(StackFrom)
      Else
        nMax = UBound(StackTo)
      End If
      For l = 1 To nMax
        Expression = ReplaceSwap(Expression, StackFrom(l), _
         StackTo(l), Start, Count, CompareMethod)
      Next 'l
  End Select
  ReplaceSwapStackArr = Expression
End Function

Public Function ReplaceSwapStackColl(ByVal Expression As String, _
 StackFrom As Collection, StackTo As Collection, _
 Optional ByVal Start As Long = 1, _
 Optional ByVal Count As Long = -1, _
 Optional ByVal CompareMethod As rxCompareMethodConstants _
 = rxCompareBinary, Optional ByVal StripMissingTo As Boolean) _
 As String

  Dim l As Long
  Dim nMax As Long
  
  Select Case StripMissingTo
    Case True
      If StackFrom.Count > StackTo.Count Then
        For l = 1 To StackTo.Count
          Expression = ReplaceSwap(Expression, CStr(StackFrom(l)), _
           CStr(StackTo(l)), Start, Count, CompareMethod)
        Next 'l
        For l = StackTo.Count + 1 To StackFrom.Count
          Expression = ReplaceSwap(Expression, CStr(StackFrom(l)), _
           "", Start, Count, CompareMethod)
        Next 'l
      Else
        For l = 1 To StackFrom.Count
          Expression = ReplaceSwap(Expression, CStr(StackFrom(l)), _
           CStr(StackTo(l)), Start, Count, CompareMethod)
        Next 'l
      End If
    Case False
      If StackTo.Count > StackFrom.Count Then
        nMax = StackFrom.Count
      Else
        nMax = StackTo.Count
      End If
      For l = 1 To nMax
        Expression = ReplaceSwap(Expression, CStr(StackFrom(l)), _
         CStr(StackTo(l)), Start, Count, CompareMethod)
      Next 'l
  End Select
  ReplaceSwapStackColl = Expression
End Function

Public Function ReplaceSwapStackObj(ByVal Expression As String, _
 StackFrom As Object, StackTo As Object, _
 Optional ByVal Start As Long = 1, _
 Optional ByVal Count As Long = -1, _
 Optional ByVal CompareMethod As rxCompareMethodConstants _
 = rxCompareBinary, Optional ByVal StripMissingTo As Boolean) _
 As String

  Dim l As Long
  Dim nMax As Long
  
  Select Case StripMissingTo
    Case True
      If StackFrom.Count > StackTo.Count Then
        For l = 1 To StackTo.Count
          Expression = ReplaceSwap(Expression, CStr(StackFrom(l)), _
           CStr(StackTo(l)), Start, Count, CompareMethod)
        Next 'l
        For l = StackTo.Count + 1 To StackFrom.Count
          Expression = ReplaceSwap(Expression, CStr(StackFrom(l)), _
           "", Start, Count, CompareMethod)
        Next 'l
      Else
        For l = 1 To StackFrom.Count
          Expression = ReplaceSwap(Expression, CStr(StackFrom(l)), _
           CStr(StackTo(l)), Start, Count, CompareMethod)
        Next 'l
      End If
    Case False
      If StackTo.Count > StackFrom.Count Then
        nMax = StackFrom.Count
      Else
        nMax = StackTo.Count
      End If
      For l = 1 To nMax
        Expression = ReplaceSwap(Expression, CStr(StackFrom(l)), _
         CStr(StackTo(l)), Start, Count, CompareMethod)
      Next 'l
  End Select
  ReplaceSwapStackObj = Expression
End Function

Public Function ReplaceSwapStackVar(ByVal Expression As String, _
 StackFrom As Variant, StackTo As Variant, _
 Optional ByVal Start As Long = 1, _
 Optional ByVal Count As Long = -1, _
 Optional ByVal CompareMethod As rxCompareMethodConstants _
 = rxCompareBinary, Optional ByVal StripMissingTo As Boolean) _
 As String

  Dim l As Long
  Dim nMax As Long
  Dim nLBoundFrom As Long
  Dim nLBoundTo As Long
  Dim nUBoundFrom As Long
  Dim nUBoundTo As Long
  Dim nFromIsString As Boolean
  Dim nToIsString As Boolean
  Dim nString As String
  Dim nArray() As String
  
  If IsObject(StackFrom) Then
    nLBoundFrom = 1
    nUBoundFrom = StackFrom.Count
  ElseIf IsArray(StackFrom) Then
    nLBoundFrom = LBound(StackFrom)
    nUBoundFrom = UBound(StackFrom)
  ElseIf VarType(StackFrom) = vbString Then
    nFromIsString = True
  End If
  If IsObject(StackTo) Then
    nLBoundTo = 1
    nUBoundTo = StackTo.Count
  ElseIf IsArray(StackTo) Then
    nLBoundTo = LBound(StackTo)
    nUBoundTo = UBound(StackTo)
  ElseIf VarType(StackTo) = vbString Then
    nToIsString = True
  End If
  Select Case True
    Case nFromIsString And nToIsString
      ReplaceSwapStackVar = ReplaceSwapStack(Expression, _
       CStr(StackFrom), CStr(StackTo), CompareMethod, _
       StripMissingTo)
      Exit Function
    Case nFromIsString
      nString = StackFrom
      If IsObject(StackTo) Then
        nLBoundFrom = 1
        nUBoundFrom = Len(nString)
      ElseIf IsArray(StackTo) Then
        nLBoundFrom = nLBoundTo
        nUBoundFrom = nLBoundTo + Len(nString) - 1
      End If
      ReDim nArray(nLBoundFrom To nUBoundFrom)
      For l = nLBoundFrom To nUBoundFrom
        nArray(l) = Mid$(nString, l - nLBoundFrom + 1, 1)
      Next 'l
      StackFrom = nArray
    Case nToIsString
      nString = StackTo
      If IsObject(StackFrom) Then
        nLBoundTo = 1
        nUBoundTo = Len(nString)
      ElseIf IsArray(StackFrom) Then
        nLBoundTo = nLBoundFrom
        nUBoundTo = nLBoundFrom + Len(nString) - 1
      End If
      ReDim nArray(nLBoundTo To nUBoundTo)
      For l = nLBoundTo To nUBoundTo
        nArray(l) = Mid$(nString, l - nLBoundTo + 1, 1)
      Next 'l
      StackTo = nArray
  End Select
  Select Case StripMissingTo
    Case True
      If nUBoundFrom > nUBoundTo Then
        For l = nLBoundFrom To nUBoundTo
          Expression = ReplaceSwap(Expression, CStr(StackFrom(l)), _
           CStr(StackTo(l)), Start, Count, CompareMethod)
        Next 'l
        For l = nUBoundTo + 1 To nUBoundTo
          Expression = ReplaceSwap(Expression, CStr(StackFrom(l)), _
           "", Start, Count, CompareMethod)
        Next 'l
      Else
        For l = nLBoundFrom To nUBoundFrom
          Expression = ReplaceSwap(Expression, CStr(StackFrom(l)), _
           CStr(StackTo(l)), Start, Count, CompareMethod)
        Next 'l
      End If
    Case False
      If nUBoundTo > nUBoundFrom Then
        nMax = nUBoundFrom
      Else
        nMax = nUBoundTo
      End If
      For l = nLBoundFrom To nMax
        Expression = ReplaceSwap(Expression, CStr(StackFrom(l)), _
         CStr(StackTo(l)), Start, Count, CompareMethod)
      Next 'l
  End Select
  ReplaceSwapStackVar = Expression
End Function

Modul modReplaceEx (modReplaceEx.bas - ca. 20,8 KB)


Artikel
Zum Download-Bereich dieses Artikel
Mail an den Autor dieses Artikels

KnowHow
Zur KnowHow-Übersicht

KnowHow-Themen
Themen - Allgemeines
Themen - Entwicklungsumgebung (VB-IDE)
Themen - Forms
Themen - Steuerelemente (Controls)
Themen - Grafik
Themen - Dateien
Themen - UserControls
Themen - Einsteiger-Tipps
Themen - Wussten Sie...?

Übersicht nach Titeln in alphabetischer Reihenfolge
Übersicht nach Erscheinungsdatum

Schnellsuche




Zum Seitenanfang

Copyright © 1999 - 2017 Harald M. Genauck, ip-pro gmbh  /  Impressum

Zum Seitenanfang

Zurück...

Zurück...

Download Internet Explorer