Office 2013: Daten einer Zelle auf mehrere aufteilen Automatisch.

[christoph_mayr]

Daten einer Zelle auf mehrere aufteilen Automatisch.

Hallo

Bin neu in diesem Forum da ich Hilfe brauch bei einer Excel Funktion bzw. wie man mein Problem am besten Lösen könnte.

Es geht darum das ich in einer Zelle sehr viele Daten habe, die Ich auf mehrere Zellen aufteilen möchte.
Da ich aber nicht so der Excel Profi bin habe ich es derzeit etwas kompliziert gelöst.
mit den Funktionen Links, Rechts, Teil.

Die Daten sind nicht immer gleich strukturiert bzw. verschieden lang.

Hawker Sidley // Frame : MW - 400 //Freq. :50 //RPM : 589 //Volt. : 380 // Rated Current : 470.6 A // Cos phi : ?? // IP : ?? // KW :250
WEG // Frame : 250 //Freq. :50 //RPM : 1480 //Volt. : 380 // Rated Current : 142 A // Cos phi : ?? // IP : 65 // KW :75

das sind zwei verschiedene Zellen jeweils in Spalte F ich möchte jetzt die Daten so auf teilen:Spalte
G= Hersteller (Hawker Sidley oder WEG) ; H=Frame ; I=Freq. ; J=RPM ; K=Volt ; L= Rated Current ; M=Cos phi; N=IP ; O=KW ;

Bitte um Hilfe da es sehr mühselig ist die Daten mit meinen bereits erstellten Formeln aufzuteilen.

Für Spalte G habe ich derzeit die Formel =LINKS(F12;SUCHEN("/";F12)-1) die funktioniert eigentlich ganz gut.
Für Spalte H-N habe ich derzeit die Formel =TEIL(F12;45;2) da aber der Text sehr variiert muss ich immer die Zahl beim erste Zeichen ändern das ist sehr viel Arbeit bei über 600 Zeilen.
Für Spalte O habe ich derzeit die Formel =RECHTS(F12;4)
 

BMM // Frame : ?? //Freq. :50 //RPM : 1450 //Volt. : 380 // Rated Current : 37 A // Cos phi : ?? // IP : ?? // KW :18.5
SEW-EURODRIVE // Frame : ?? //Freq. :50 //RPM : 1400 //Volt. : 380 // Rated Current : 8.6 A // Cos phi : 0.83 // IP : ?? // KW :2.2
Kleines bespiel wie es aussehen sollte.

Spalte F=WEG // Frame : 250 //Freq. :50 //RPM : 1480 //Volt. : 380 // Rated Current : 142 A // Cos phi : ?? // IP : 65 // KW :75
Spalte G=WEG (manchmal 2 Zeichen und bis hin zu 7 Zeichen lang)
Spalte H=250 (manchmal 2 Zeichen und bis hin zu 7 Zeichen lang)
Spalte I=50 (immer 2 Zeichen lang nur dadurch das die ersten zwei immer verschieden lang sind variiert die Position sehr ca. zwischen 2 und 20 Zeichen)
Spalte J=1480 (manchmal 2 Zeichen und bis hin zu 4 Zeichen lang)
Spalte K=380 (immer 3 Zeichen lang nur dadurch das die vorderen immer verschieden lang sind variiert die Position sehr ca. zwischen 2 und 20 Zeichen)
Spalte L=142 (manchmal 2 Zeichen und bis hin zu 4 Zeichen lang)
Spalte M=?? (manchmal 2 Zeichen und bis hin zu 4 Zeichen lang)
Spalte M=65 (manchmal 2 Zeichen und bis hin zu 4 Zeichen lang)




Danke schon mal im voraus.

Es ist egal ob es mit Formel oder mit VBA Skript Funktionieren würde.

MFG
Christoph

[DL]

Hallo Christoph

Mit Power Query.
Mein exemplarischer Code:

Code: [Auswählen]

let
    Quelle = Excel.CurrentWorkbook(){[Name="Tabelle1"]}[Content],
    #"Geänderter Typ" = Table.TransformColumnTypes(Quelle,{{"Spalte1", type text}}),
    #"Spalte nach Trennzeichen teilen" = Table.SplitColumn(#"Geänderter Typ","Spalte1",Splitter.SplitTextByDelimiter("//"),{"Spalte1.1", "Spalte1.2", "Spalte1.3", "Spalte1.4", "Spalte1.5", "Spalte1.6", "Spalte1.7", "Spalte1.8", "Spalte1.9"}),
    #"Geänderter Typ1" = Table.TransformColumnTypes(#"Spalte nach Trennzeichen teilen",{{"Spalte1.1", type text}, {"Spalte1.2", type text}, {"Spalte1.3", type text}, {"Spalte1.4", type text}, {"Spalte1.5", type text}, {"Spalte1.6", type text}, {"Spalte1.7", type text}, {"Spalte1.8", type text}, {"Spalte1.9", type text}}),
    #"Ersetzter Wert" = Table.ReplaceValue(#"Geänderter Typ1"," Frame : ","",Replacer.ReplaceText,{"Spalte1.2"}),
    #"Ersetzter Wert1" = Table.ReplaceValue(#"Ersetzter Wert","Freq. :","",Replacer.ReplaceText,{"Spalte1.3"}),
    #"Ersetzter Wert2" = Table.ReplaceValue(#"Ersetzter Wert1","RPM : ","",Replacer.ReplaceText,{"Spalte1.4"}),
    #"Ersetzter Wert3" = Table.ReplaceValue(#"Ersetzter Wert2","Volt. : ","",Replacer.ReplaceText,{"Spalte1.5"}),
    #"Ersetzter Wert4" = Table.ReplaceValue(#"Ersetzter Wert3"," Rated Current : ","",Replacer.ReplaceText,{"Spalte1.6"}),
    #"Ersetzter Wert5" = Table.ReplaceValue(#"Ersetzter Wert4"," Cos phi : ","",Replacer.ReplaceText,{"Spalte1.7"}),
    #"Ersetzter Wert6" = Table.ReplaceValue(#"Ersetzter Wert5"," IP : ","",Replacer.ReplaceText,{"Spalte1.8"}),
    #"Ersetzter Wert7" = Table.ReplaceValue(#"Ersetzter Wert6"," KW :","",Replacer.ReplaceText,{"Spalte1.9"}),
    #"Ersetzter Wert8" = Table.ReplaceValue(#"Ersetzter Wert7"," A ","",Replacer.ReplaceText,{"Spalte1.6"}),
    #"Geänderter Typ2" = Table.TransformColumnTypes(#"Ersetzter Wert8",{{"Spalte1.3", Int64.Type}, {"Spalte1.4", Int64.Type}, {"Spalte1.5", Int64.Type}, {"Spalte1.9", Int64.Type}})
in
    #"Geänderter Typ2"

[DL]

Kannst du mir erklären wie ich denn Code in mein Excel File reinbekomme ?
Bin nicht so der Excel Profi hab es in denn VBA editor mal reingeladen das geht das aber nicht.

Wie gesagt das ist Power Query Code. Ich bezweifle dass man den so einfach übernehmen kann.
In erster Linie soll es dem Vergleich mit dem Code den du erstellst dienen.

Eine Voraussetzung für Power Query ist dass die Daten in einer formatierten Tabelle stehen. Und die benötigt Überschriften. Daher die Bezeichnung Spalte1.

Wenn ich mir aber deine Beispielmappe (aus dem anderen Forum) ansehe dann ist die Spalte mit den Texten Bestandteil einer größeren Liste und nicht - wie ich vermutet habe - eine importierte Liste mit nur dieser einen Spalte.
Daher würde meine Lösung nur mit einer Umstellung des Datenmodells einher gehen.

Außerdem ist noch offen ob du überhaupt über Power Query verfügst.

[christoph_mayr]

Hallo Detlef

Habe es jetzt mal mit deine Vorschlag gelöst über Power Query
Funktioniert nicht schlecht, nur ein kleiner nachteil besteht mit diese Funktion,
wenn sich in der Tabelle was ändert werden die neuen Daten nicht übernommen.

mein derzeitiger Code:

Code: [Auswählen]

let
    Quelle = Excel.Workbook(File.Contents("Z:\004_DETAIL_PHASE_2\Site Motor and MCC survey 1011-Final.xlsx"), null, true),
    #"MCC MOTOR SURVEY_Sheet" = Quelle{[Item="MCC MOTOR SURVEY",Kind="Sheet"]}[Data],
    #"Abgeschnittener Text eingefügt" = Table.AddColumn(#"MCC MOTOR SURVEY_Sheet", "Trim", each Text.Trim([Column6]), type text),
    #"Neu angeordnete Spalten" = Table.ReorderColumns(#"Abgeschnittener Text eingefügt",{"Column1", "Column2", "Column3", "Column4", "Column5", "Column6", "Trim", "Column7", "Column8", "Column9", "Column10", "Column11", "Column12", "Column13", "Column14", "Column15", "Column16", "Column17", "Column18", "Column19", "Column20", "Column21", "Column22", "Column23", "Column24", "Column25", "Column26", "Column27", "Column28", "Column29", "Column30", "Column31"}),
    #"Umbenannte Spalten" = Table.RenameColumns(#"Neu angeordnete Spalten",{{"Trim", "Columme6.1"}}),
    #"Spalte nach Trennzeichen teilen" = Table.SplitColumn(#"Umbenannte Spalten","Columme6.1",Splitter.SplitTextByDelimiter("//", QuoteStyle.Csv),{"Columme6.1.1", "Columme6.1.2", "Columme6.1.3", "Columme6.1.4", "Columme6.1.5", "Columme6.1.6", "Columme6.1.7", "Columme6.1.8", "Columme6.1.9"}),
    #"Geänderter Typ" = Table.TransformColumnTypes(#"Spalte nach Trennzeichen teilen",{{"Columme6.1.1", type text}, {"Columme6.1.2", type text}, {"Columme6.1.3", type text}, {"Columme6.1.4", type text}, {"Columme6.1.5", type text}, {"Columme6.1.6", type text}, {"Columme6.1.7", type text}, {"Columme6.1.8", type text}, {"Columme6.1.9", type text}}),
    #"Ersetzter Wert" = Table.ReplaceValue(#"Geänderter Typ","Frame :","",Replacer.ReplaceText,{"Columme6.1.2"}),
    #"Ersetzter Wert1" = Table.ReplaceValue(#"Ersetzter Wert","Freq. :","",Replacer.ReplaceText,{"Columme6.1.3"}),
    #"Ersetzter Wert2" = Table.ReplaceValue(#"Ersetzter Wert1","RPM :","",Replacer.ReplaceText,{"Columme6.1.4"}),
    #"Ersetzter Wert3" = Table.ReplaceValue(#"Ersetzter Wert2","Volt. :","",Replacer.ReplaceText,{"Columme6.1.5"}),
    #"Ersetzter Wert4" = Table.ReplaceValue(#"Ersetzter Wert3","Rated Current :","",Replacer.ReplaceText,{"Columme6.1.6"}),
    #"Ersetzter Wert5" = Table.ReplaceValue(#"Ersetzter Wert4","Cos phi :","",Replacer.ReplaceText,{"Columme6.1.7"}),
    #"Ersetzter Wert6" = Table.ReplaceValue(#"Ersetzter Wert5","IP :","",Replacer.ReplaceText,{"Columme6.1.8"}),
    #"Ersetzter Wert7" = Table.ReplaceValue(#"Ersetzter Wert6","KW :","",Replacer.ReplaceText,{"Columme6.1.9"}),
    #"Bereinigter Text" = Table.TransformColumns(#"Ersetzter Wert7",{{"Columme6.1.1", Text.Clean}, {"Columme6.1.2", Text.Clean}, {"Columme6.1.3", Text.Clean}, {"Columme6.1.4", Text.Clean}, {"Columme6.1.5", Text.Clean}, {"Columme6.1.6", Text.Clean}, {"Columme6.1.7", Text.Clean}, {"Columme6.1.8", Text.Clean}, {"Columme6.1.9", Text.Clean}}),
    #"Ersetzter Wert8" = Table.ReplaceValue(#"Bereinigter Text","A","",Replacer.ReplaceText,{"Columme6.1.6"}),
    #"Abgeschnittener Text" = Table.TransformColumns(#"Ersetzter Wert8",{{"Columme6.1.2", Text.Trim}, {"Columme6.1.3", Text.Trim}, {"Columme6.1.4", Text.Trim}, {"Columme6.1.5", Text.Trim}, {"Columme6.1.1", Text.Trim}, {"Columme6.1.6", Text.Trim}, {"Columme6.1.7", Text.Trim}, {"Columme6.1.8", Text.Trim}, {"Columme6.1.9", Text.Trim}}),
    #"Geänderter Typ1" = Table.TransformColumnTypes(#"Abgeschnittener Text",{{"Columme6.1.3", type number}, {"Columme6.1.4", type number}, {"Columme6.1.5", type number}, {"Columme6.1.6", type number}, {"Columme6.1.7", type number}, {"Columme6.1.8", type number}, {"Columme6.1.9", type number}}),
    #"Zusammengeführte Spalten" = Table.CombineColumns(#"Geänderter Typ1",{"Column7", "Column8", "Column9", "Column10", "Column11", "Column12", "Column13", "Column14", "Column15"},Combiner.CombineTextByDelimiter("//", QuoteStyle.None),"test"),
    #"Entfernte Spalten" = Table.RemoveColumns(#"Zusammengeführte Spalten",{"test"})
in
    #"Entfernte Spalten"

Setzt mich heute am Abend mal mit einen alten Bekanten zusammen.
Ob man diesen Sonderabfall mit einen VBA Makro lösen kann.

MFG

Christoph

selbst verständlich gibt es dann den  VBA Code hier wenn er funzt.

[gmg-cc]

Funktioniert nicht schlecht, nur ein kleiner nachteil besteht mit diese Funktion,
wenn sich in der Tabelle was ändert werden die neuen Daten nicht übernommen.

Na ja, wenn du die (neue) Tabelle nicht aktualisierst, kann das auch nicht gehen. 

[christoph_mayr]

Hallo Alle zusammen.

So hab mich gestern Abend mit einem Bekannten zusammen gesetzt um das Problem mit einen VBA Code zu Lösen.
Das funktioniert echt super.

Hier der VBA Code für die ihn brauchen könnten.

Code: [Auswählen]

' Initale Generierung der Daten über die Komplette Tabelle
Sub init()
    Dim Zeile As Integer
    Zeile = 14
    While Cells(Zeile, 2) <> ""
        If Cells(Zeile, 6) <> "" Then
            Call splitData(Zeile)
        End If
        Zeile = Zeile + 1
    Wend
End Sub

' Aktualisierung der Daten bei änderung der Zelle
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Row > 6 And Target.Column = 6 Then
        For i = 0 To 8
            Cells(Target.Row, i + 7) = ""
        Next i
        Call splitData(Target.Row)
    End If
End Sub

' Daten aus Spalte 6/F der jeweiligen Zeile auslesen
' Zerlegen und die die weiteren Spalten eintragen
Sub splitData(Zeilennummer As Integer)
    Dim line As String
    Dim WrdArray() As String
    Dim WrdArray2() As String
    Dim StaArray
    Dim EndArray
   
    ' Zelle einlesen
    line = Cells(Zeilennummer, 6).Value
   
    ' Zerlegen mit Teiler //
    WrdArray() = Split(line, "//")
   
    ' wenn 9 Teile gefunden wurden
    If UBound(WrdArray) = 8 Then
       
        ' Über die 9 Teile drüber gehen
        For i = 0 To 8
        ' Falls ein Fehler passiert (bei umwandlung in Zahl) diesen einen Teil überspringen
        On Error GoTo Fehler
       
            ' Versuchen den Teil nochmal mit Teiler : zu zerlegen
            WrdArray2() = Split(WrdArray(i), ":")
           
            ' Wenn das geklappt hat und 2 weitere Teilen entstanden sind
            If UBound(WrdArray2) = 1 And i <> 5 Then
                ' den 2. Teil in die jeweilige Zelle eintragen
                Cells(Zeilennummer, i + 7) = Trim(WrdArray2(1))
            ' ausser es handelt sich um die 6. Spalte (Strom)
            ElseIf UBound(WrdArray2) = 1 And i = 5 Then
                l = Len(Trim(WrdArray2(1)))
                ' dann noch das A wegschneiden
                Cells(Zeilennummer, i + 7) = CDbl(Left(Trim(WrdArray2(1)), l - 2))
            ' konnte nicht geteilt werden alles in die Zelle eintragen
            Else
                Cells(Zeilennummer, i + 7) = WrdArray(i)
            End If
Fehler:
        Next i
    End If
End Sub

MFG

Christoph