Microsoft Excel

Herbers Excel/VBA-Archiv

mehrere variablen aus einer zelle bilden



Excel-Version: 8.0 (Office 97)

Betrifft: mehrere variablen aus einer zelle bilden
von: a. w.
Geschrieben am: 23.08.2002 - 15:27:58

in einer excel tabelle befinden sich mehrere informationen, getrennt durch ein Komma, in einer zelle. wie kann ich nun die einzelnen teile dieser informationen in verschiedene variablen speichern?

  

Re: mehrere variablen aus einer zelle bilden
von: ChristianG
Geschrieben am: 23.08.2002 - 16:08:19

hallo,

vielleicht hilft es Dir, wenn Du die Datei als Textdatei speicherst und anschliessend wieder mit Excel oeffnest.

Dann kannst Du einstellen, dass die Teile durch ein Komma getrennt sind.

mfg
Christian


  

Re: mehrere variablen aus einer zelle bilden
von: Axel
Geschrieben am: 23.08.2002 - 16:08:44

Hallo,

seit Office 2000 gibt es dazu die Funktion split().

Für Office97 kann ich Dir Workarounds als Ersatz für einige Office2000-Funktionen anbieten. Schau doch mal, ob Du damit klar kommst.

Übernehme einfach den gesamten Code in neues Modul.

Gruß
Axel


Option Explicit

#If VBA6 = False Then

' © 2002, EDV-Beratung Axel König
'
' Workarounds für Funktionen, die in Office97 noch nicht vorhanden waren.
' Dieser Code wird wegen der ab Office2000 gesetzten Konstante VBA6
' ab Office2000 nicht kompiliert.
'
' Es entstehen deshalb keine Konflikte zu den dort mit identischen
' Namen standardmäßig zur Verfügung stehenden Funktionen
'
' Ich übernehme keine Gewähr für die absolut korrekte
' Arbeitsweise der Funktionen
'
' Dieser Code kann beliebig dubliziert und weitergeben werden, solange
' die Copyright-Hinweise auf den Autor erhalten bleiben
'

Const C_DIMSIZE = 128  ' dynamische Arrays werden in Schritten von C_DIMSIZE
                       ' dimensioniert

Function Join(SourceArray As Variant, Optional Delimiter As Variant) As String

   Dim As Integer
   Dim str As String
   
   ' falls kein Delimiter angegeben ist, dann default eine Leerzeichen verwenden
   If (IsMissing(Delimiter)) Then Delimiter = " "
   
   ' alle Elemente bis auf das letzte mit angegebenem Trenner verketten
   For i = LBound(SourceArray) To UBound(SourceArray) - 1
      str = str & SourceArray(i) & Delimiter
   Next
   
   ' letztes Element anfügen
   Join = str & SourceArray(UBound(SourceArray))
   
End Function


Public Function InStrRev(StringCheck As String, StringMatch As String, _
                         Optional Start As Long = -1, _
                         Optional Compare As VbCompareMethod = vbBinaryCompare) As Variant

   Dim intPos As Integer, intPosLast As Integer
   Dim lngStart As Long
   
   ' Rückgabe gemäß Konvention:
   '
   ' StringCheck = vbNullString (also "", Länge = 0): 0
   ' Start > len(StringCheck)                       : 0
   '
   ' !!! folgendes entgegen der Dokumentation !!!
   ' StringMatch = vbNullString (also "", Länge = 0):
   '                                wenn Start = -1 : Länge StringCheck
   '                                wenn Start >  0 : Start
   
   
   If (Len(StringCheck) = 0 Or Start > Len(StringCheck)) Then
      InStrRev = 0
   
   ElseIf (Len(StringMatch) = 0) Then
      InStrRev = IIf(Start = -1, Len(StringCheck), 0)
   
   Else
      lngStart = IIf(Start = -1, 99999, Start)
      
      Do
         intPosLast = intPos
         intPos = InStr(IIf(intPos, intPos + 1, 1), StringCheck, StringMatch, Compare)
      Loop While (intPos > 0 And intPos < lngStart)
   
      InStrRev = intPosLast
   
   End If
   
End Function


' da es in Office97 bereits die Replace()-Methode zum Ersetzen von
' Zeichenfolgen in Range-Objekten gibt, kann die hier zur Verfügung
' gestellte Version nicht identisch bezeichnet werden

Public Function Replace97(Expression As String, Find As String, _
                          Replace As String, _
                          Optional Start As Long = 1, _
                          Optional Count As Long = -1, _
                          Optional Compare As VbCompareMethod = vbBinaryCompare) As String
                          
   ' Das in der Originalversion verwendete letzte optionale Argument Compare
   ' zur Festlegung der Vergleichsmethode (siehe die Klasse vbCompareMethod)
   ' wird hier nicht verwendet
         
   Dim As Integer
   Dim lngCount As Long
   Dim strExp As String, strNew As String
   Dim As Variant, var As Variant
   
   ' zunächst Inhalte der Argumente prüfen
   If (Len(Expression) = 0) Then Exit Function
   
   ' da die Funktionsparameter gemäß der Vorgabe der Originalfunktion hier
   ' ByRef übergeben werden und sich der Inhalt von Count ggf. ändert,
   ' wird hier eine lokale Variable verwendet
   lngCount = IIf(Count = -1, 99999, Count)
    
   If (Len(Find) = 0 Or Start < 1 Or lngCount < 1) Then
      Replace = Expression
      Exit Function
   End If
  
   ' falls Ersetzung nicht ab erstem Zeichen erfolgen soll,
   ' den Ausgangsstring entsprechend anpassen
   ' bei ByRef-Übergabe hier ebenfalls Verwendung einer lokalen Variablen
   If (Start > 1) Then
      strExp Right(Expression, Len(Expression) - Start + 1)
   Else
      strExp = Expression
   End If
   
   ' Ausgangsstring zerlegen, dabei die zu ersetzende Zeichenfolge als
   ' Trennstring verwenden
   var = Split(strExp, Find)
   
   ' jetzt alle Teilstrings durchlaufen
   ' und den Zielstring mit den Ersetzungszeichen zusammensetzen
   For i = 0 To UBound(var) - 1
      If (i < lngCount) Then
         strNew = strNew & var(i) & Replace
      Else
         strNew = strNew & var(i) & Find
      End If
   Next
   
   ' letztes Element anfügen
   strNew = strNew & var(i)
   
   ' neue Zeichenfolge zurückgeben
   Replace97 = strNew
   
End Function
   
   
Public Function Split(Expression As String, Optional Delimiter As Variant = " ", _
                      Optional Limit As Long = -1, _
                      Optional Compare As VbCompareMethod = vbBinaryCompare) As Variant
   
   ' Das in der Originalversion verwendete letzte optionale Argument Compare
   ' zur Festlegung der Vergleichsmethode (siehe die Klasse vbCompareMethod)
   ' wird hier nicht verwendet
   
   Dim astr() As String  ' Arry, dass zurückgegeben wird
   Dim lngLimit As Long
   Dim As Integer, intLastPos As Integer, intPos As Integer
   
   If (Len(Delimiter) = 0) Then
      
      ' gemäß Konvention:
      ' Wenn delimiter eine Zeichenfolge der Länge Null ist, wird ein aus einem
      ' Element bestehendes Datenfeld, das die gesamte Zeichenfolge von expression
      ' enthält, zurückgegeben.
         
      ReDim astr(0)
      astr(0) = Expression
     
   Else
   
      ' max. Anzahl setzen
      ' da der Funktionsparameter Limit hier geändert wird, und
      ' die Syntax der Originalfunktion (ByRef statt ByVal) beibehalten bleiben
      ' soll, wird hier eine lokale Variable verwendet
      ' -1 da der erste Index des Array = 0 und nicht 1 ist
      Select Case Limit
         Case -1
            ' -1 ist der Default-Wert und bedeutet alle Teilstrings sollen
            ' zurückgegeben werden
            lngLimit = 99999
         
         Case Is < 1:
            ' falsches Limit angegeben
            ' die Behandlung der Übergabe des Wertes 0 in der Originalfunktion,
            ' nämlich ein Array der Dimension(-1) zurückzugeben, kann hier nicht
            ' simuliert werden
            Err.Raise 5
            
         Case Else
            lngLimit = Limit - 1
            ' Limit -1 da der erste Index des Array = 0 und nicht 1 ist
      End Select
      
      Do
         ' Position des Trennzeichens/-Strings finden
         ' dabei Start der Suche nach letztem gefundenen Trenner beginnen
         intPos = InStr(intPos + 1, Expression, Delimiter)
         
         ' Trennzeichen-/String gefunden und Limit noch nicht erreicht
         If (intPos > 0 And i < lngLimit) Then
            
            ' Array (neu) dimensionieren
            If (i Mod C_DIMSIZE = 0) Then ReDim Preserve astr(i + C_DIMSIZE)
            
            ' Teilbereich zuweisen
            astr(i) = Mid(Expression, intLastPos + IIf(i = 0, 1, Len(Delimiter)), _
                          intPos - intLastPos - IIf(i = 0, 1, Len(Delimiter)))
            
            ' Position merken
            intLastPos = intPos
            
         ' keine (weiteren) Trennzeichen-/Strings enthalten
         ' oder aber das Limit erreicht
         Else
            ' Array gg. neu dimensionieren
            If (i Mod C_DIMSIZE = 0) Then ReDim Preserve astr(i + C_DIMSIZE)
         
            ' dann den Rest zuweisen
            astr(i) = Right(Expression, Len(Expression) - intLastPos - _
                           (Len(Delimiter) - 1))
                      
            ' Array auf korrekte Größe dimensionieren
            ReDim Preserve astr(i)
            
         End If
         
         i = i + 1
         
      ' Schleife solange laufen lassen wie Trenner gefunden werden
      ' und das Limit noch nicht überschritten ist
      Loop While (intPos And i <= lngLimit)
   End If
   
   ' Array zurückgeben
   Split = astr
End Function

#End If


 

Beiträge aus den Excel-Beispielen zum Thema "mehrere variablen aus einer zelle bilden"