alphanumerische Daten

Forumthread: alphanumerische Daten

05.07.2016 10:35:29

Bianca

Hallo an alle,
ich hab hier ein Problem, dass ich alleine nicht lösen konnte.
Folgende Aufgabenstellung:
in Spalte A habe ich alphanummerische Daten (Bsp. 6A B 3(AB) A 4C)
ich muss diese auf Spalten trennen, Ergebnis: AAAAAABABABABACCCC
weiter muss ich die Anzahl der Buchstabenwechsel zählen (in diesem Fall 9)
siehe auch Bsp. im Anhang.
gibt es eine Möglichkeit das mit einer Formel zu machen? ich hab 400 Datensätze die sich alle im Aufbau unterscheiden!
Besten Dank im Voraus!
lg Bianca
https://www.herber.de/bbs/user/106760.xlsx

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: alphanumerische Daten

05.07.2016 12:40:55

ChrisL
AW: alphanumerische Daten

06.07.2016 11:37:21

Bianca
AW: per VBA

05.07.2016 13:38:49

UweD
AW: die Wechsel fehlen ja noch.

05.07.2016 14:20:18

UweD
AW: die Wechsel fehlen ja noch.

06.07.2016 11:36:19

Bianca

AW: alphanumerische Daten

05.07.2016 12:40:55

ChrisL

Hi Bianca
Zeig mal die Datei mit allen 400 Datensätzen.
Gruss
Chris

AW: alphanumerische Daten

06.07.2016 11:37:21

Bianca

hallo, danke dir...ich versuche es mit uwe's lösung!
lg bianca

AW: per VBA

05.07.2016 13:38:49

UweD

Hallo
puhhh
hab mal eine Lösung mit VBA gebastelt...
Wo man alles drauf achten muss
- Aufspalten mit Leerzeichen als Trenner
- Aber nicht innerhalb der Klammern
- Evtl. mehrere Klammern möglich
- Usw.

Option Explicit

Sub ABC()

    Dim Zelle, TXT
    Dim Pos1 As Integer, Pos2 As Integer, ANZ As Integer, Bis As Integer
    Dim i As Integer, j As Integer, k As Integer, l As Integer, z As Integer
    Dim Erst As String, TMP As String
    Range("B:XX").ClearContents
    For Each Zelle In Columns(1).SpecialCells(xlCellTypeConstants, 3)
        'Leerzeichen in den () löschen 
        TMP = Zelle
        ANZ = Len(TMP) - Len(Replace(TMP, "(", ""))
        For i = 1 To ANZ
            Pos1 = WorksheetFunction.Find("(", TMP)
            Pos2 = WorksheetFunction.Find(")", TMP)
            TMP = Left(TMP, Pos1 - 1) & "[" & _
                Replace(Mid(TMP, Pos1 + 1, Pos2 - Pos1 - 1), " ", "") & _
                "]" & Mid(TMP, Pos2 + 1)
        Next
        
        'Aufspalten 
        z = 1
        TXT = Split(TMP, " ")
        For j = 0 To Ubound(TXT)
            Erst = Left(TXT(j), 1)
            If IsNumeric(Erst) Then
                If Mid(TXT(j), 2, 1) = "[" Then
                    ANZ = Len(TXT(j)) - 3
                Else
                    ANZ = 1
                End If
                For k = 1 To Erst
                    For l = 1 To ANZ
                        Zelle.Offset(0, z) = Mid(Replace(TXT(j), "[", ""), l + 1, 1)
                        z = z + 1
                    Next l
                Next k
            Else
                Zelle.Offset(0, z) = TXT(j)
                z = z + 1
            End If
        Next
    Next
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0

Gruß UweD

AW: die Wechsel fehlen ja noch.

05.07.2016 14:20:18

UweD

- Ich war davon ausgegangen, so wie in der Datei, dass Leerzeichen in den Klammern vorhanden sind.
Wenn dem nicht so ist, dann wird es kürzer.
- Desweiteren, nur einstellige Ziffern
Hier noch der eingebaute Zähler zum Wechsel der Buchstaben

Option Explicit

Sub ABC()

    Dim Zelle, TXT
    Dim Pos1 As Integer, Pos2 As Integer, ANZ As Integer, Bis As Integer
    Dim i As Integer, j As Integer, k As Integer, l As Integer, z As Integer
    Dim Wechsel As Integer
    Dim Erst As String, TMP As String
    With ActiveSheet
        .Range("B:XX").ClearContents
        For Each Zelle In .Columns(1).SpecialCells(xlCellTypeConstants, 3)
            'Leerzeichen in den () löschen 
            TMP = Zelle
            ANZ = Len(TMP) - Len(Replace(TMP, "(", ""))
            For i = 1 To ANZ
                Pos1 = WorksheetFunction.Find("(", TMP)
                Pos2 = WorksheetFunction.Find(")", TMP)
                TMP = Left(TMP, Pos1 - 1) & "[" & _
                    Replace(Mid(TMP, Pos1 + 1, Pos2 - Pos1 - 1), " ", "") & _
                    "]" & Mid(TMP, Pos2 + 1)
            Next
            
            'Aufspalten 
            z = 1
            TXT = Split(TMP, " ")
            For j = 0 To Ubound(TXT)
                Erst = Left(TXT(j), 1)
                If IsNumeric(Erst) Then
                    If Mid(TXT(j), 2, 1) = "[" Then
                        ANZ = Len(TXT(j)) - 3
                    Else
                        ANZ = 1
                    End If
                    For k = 1 To Erst
                        For l = 1 To ANZ
                            Zelle.Offset(0, z) = Mid(Replace(TXT(j), "[", ""), l + 1, 1)
                            z = z + 1
                        Next l
                    Next k
                Else
                    Zelle.Offset(0, z) = TXT(j)
                    z = z + 1
                End If
            Next
            
            'Wechsel berechnen 
            Wechsel = 0
            For k = 2 To z
                If .Cells(Zelle.Row, k + 1) <> .Cells(Zelle.Row, k) Then
                    Wechsel = Wechsel + 1
                End If
            Next
            Zelle.Offset(0, z + 2) = "Wechsel: " & Wechsel - 1
        Next
    End With
End Sub

VBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 15 - mit VBAHTML 12.6.0

Gruß UweD

AW: die Wechsel fehlen ja noch.

06.07.2016 11:36:19

Bianca

wow...werde ich gleich versuchen!
vielen dank uwe!!

Beliebteste Forumthreads (12 Monate)

Forumthread: alphanumerische Daten

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread