Anzeige
Archiv - Navigation
1500to1504
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

alphanumerische Daten

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
Anzeige
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

Anzeige
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

Anzeige
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)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige