Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Alphanumerischen String zerlegen und übertragen

Betrifft: Alphanumerischen String zerlegen und übertragen von: Constantin
Geschrieben am: 17.04.2015 20:58:59

Hallo,

in einer Mappe1, Tabelle1, habe ich in Spalte A alphanumerische Bezeichnungen, z.B. S911B, ABC, S230TD12X usw.. Jeder Buchstabe und jede Ziffer stellt eine Ebene dar.
Im ersten Schritt möchte ich feststellen, wie viele Ebenen der jeweilige String hat. Eine Besonderheit gibt es: Folgen drei Ziffern aufeinander, zählen diese als eine Ebene". ABC hat somit 3 Ebenen, S911B ebenso, weil drei Ziffern als eine Ebene zählen. Mehr als drei Ziffern in Folge gibt es nicht.

Diese Anzahl wird als Zahl in Spalte B übertragen.

Im zweiten Schritt soll der String bis zur jeweiligen Ebene "zerlegt" und in die Folgespalten übertragen werden. Einträge erfolgen nur bis zur sechsten Stufe bzw. Ebene.

Das Ergebnis für den String S911B sieht so aus:
Spalte B: 3 (Anzahl Ebenen)
Spalte C: S (Ebene 1)
Spalte D: S911 (Ebene 2)
Spalte E: S911B (Ebene 3)
(mehr Ebenen hat dieser String nicht).

Vielleicht wird es verständlicher mit der beigefügten Datei. Für eine Idee, wie ich diese Ebenen per VBA ermitteln kann, wäre ich sehr dankbar.

Grüße, Constantin

https://www.herber.de/bbs/user/97143.xlsx

  

Betrifft: Wozu brauch man so was? von: Michael
Geschrieben am: 17.04.2015 22:53:08

Hallo Constantin,

mit folgendem Makro in Tabelle1 läuft's:

Option Explicit
Sub ebenen()
Dim wert, pattern As String
Dim i, j, zeile, spalte, laenge, ebenen As Long
Dim zeichen As Byte

For zeile = 12 To 28
 wert = Range("A" & zeile).Value
 laenge = Len(wert)
 pattern = ""
  For i = 1 To laenge
   zeichen = Asc(Mid(wert, i, 1))
   If zeichen > 64 And zeichen < 91 Then
     pattern = pattern & "C"
   Else
     If zeichen > 47 And zeichen < 58 Then
     Select Case Mid(pattern, Len(pattern), 1)
       Case "C": pattern = pattern & "1"
       Case "1": pattern = pattern & "2"
       Case "2": pattern = pattern & "3"
       Case Else: MsgBox "Fehler"
     End Select
   End If
   End If
 Next i
 pattern = Replace(pattern, "123", "333")
 pattern = Replace(pattern, "12", "CC")
' Debug.Print wert
' Debug.Print pattern
 i = 1
 ebenen = 0
 While i <= laenge
   Select Case Mid(pattern, i, 1)
       Case "C", "1": i = i + 1
       Case "3": i = i + 3
       Case Else: MsgBox "Fehler"
     End Select
   ebenen = ebenen + 1
   If ebenen < 7 Then Cells(zeile, ebenen + 2).Value = Mid(wert, 1, i - 1)
 Wend
 Cells(zeile, 2).Value = ebenen
Next zeile
End Sub
Ich hatte dauernd das Gefühl, an einer echt eleganten Lösung vorbeizuschrammen, aber ich kam nicht drauf... Dann halt so.

Ach so: das erste Zeichen muß ein Buchstabe sein, sonst mußt Du es halt ändern in:
If zeichen > 47 And zeichen < 58 Then
       If pattern = "" Then
         pattern = "1"
       Else
        Select Case Mid(pattern, Len(pattern), 1)
          Case "C": pattern = pattern & "1"
          Case "1": pattern = pattern & "2"
          Case "2": pattern = pattern & "3"
          Case Else: MsgBox "Fehler"
        End Select
       End If
     End If
Profis aus Programmiersprachen wie Perl kennen eine Funktion, die sich regex ("regular expressions") nennt, wer sich damit auskennt, tut sich leichter.

Einige IFs hätte man als Select/Case gestalten könnnen, das zweite Case als IF (ich hatte tatsächlich die Aufgabenstellung schon wieder vergessen und zweistellige Zahlen als Ebenen ausgegeben).

Na dann, viel Spaß und happy exceling,

Michael


  

Betrifft: AW: Super gelöst! von: Constantin
Geschrieben am: 18.04.2015 08:12:11

Hallo Michael,

vielen Dank für diese Lösung! Funktioniert bestens. Jetzt lassen sich Werte, die hinter diesen Bezeichnungen stehen, leichter ebenen-bezogen auswerten und Zusammenhänge innerhalb der Ebenen abbilden.

Ich werde noch ein bisschen Zeit brauchen - und Freude daran haben(!) - die einzelnen Programmschritte genau nachzuvollziehen.

Also, vielen Dank nochmal.

Grüße, Constantin


  

Betrifft: Freut mich, wenn Du Dich freust von: Michael
Geschrieben am: 18.04.2015 17:15:41

Hallo Constantin,

vielen Dank für die Rückmeldung!

Schöne Grüße,

Michael


 

Beiträge aus den Excel-Beispielen zum Thema "Alphanumerischen String zerlegen und übertragen"