Microsoft Excel

Herbers Excel/VBA-Archiv

Variables Trennen von Spalten

Betrifft: Variables Trennen von Spalten von: Meier
Geschrieben am: 22.09.2014 22:24:46

Hallo liebe Excelfreunde,

ich muss ein VBA makro schreiben habe jedoch nach längerem Rumprobieren leider immer noch keinen ansatz. Um kurz mein Problem zu erläutern:
Das Ausgangssheet hat folgendes Format:

A B C E F G I J K L
1 A1 B1 C1 E1 F1 01|02 1 1 1 1
2 A2 B2 C2 E2 F2 01|02|03 2 2 2 2
2 A3 B3 C3 E3 F3 01 02|03 3 3 3
usw.

und muss in einem neuen sheet in folgendes Format gebracht werden:

A B C E F G I J K L
1 A1 B1 C1 E1 F1 01 1 1 1 1
2 A1 B1 C1 E1 F1 02 1 1 1 1
3 A2 B2 C2 E2 F2 01 2 2 2 2
4 A2 B2 C2 E2 F2 02 2 2 2 2
5 A2 B2 C2 E2 F2 03 2 2 2 2
6 A3 B3 C3 E3 F3 01 02 3 3 3
7 A3 B3 C3 E3 F3 01 03 3 3 3

Zu beachten ist, dass die Anzahl der Elemente die durch einen strich getrennt sind variabel ist. Ebenfalls hat Excel leider standardmäßig eine einstellung das aus 01 der eintrag 1 gemacht wird. D.h. die Zellen müssen mitformatiert werden.

Die Anzahl der Zeilen ist Variabel. Ich lade noch ein kleines Excelsheet hoch welches mein Problem etwas anschaulicher macht.
https://www.herber.de/bbs/user/92755.xlsx

Ich hoffe das mir jemand helfen kann.

  

Betrifft: AW: Variables Trennen von Spalten von: Beverly
Geschrieben am: 23.09.2014 10:00:48

Hi,

vielleicht so:

Option Explicit
Dim varKontakt

Sub Trennen()
    Dim lngLetzte As Long
    Dim lngZeile As Long
    Dim lngStart As Long
    lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), Cells(Rows.Count, 1).End(xlUp).Row, Rows. _
Count)
    For lngZeile = lngLetzte To 2 Step -1
        If InStr(Cells(lngZeile, 8), "|") > 0 Then
            varKontakt = Split(Cells(lngZeile, 8).Text, "|")
            lngStart = lngZeile + UBound(varKontakt) - 1
            Ausfuehren lngZeile, lngStart, 8
        ElseIf InStr(Cells(lngZeile, 9), "|") > 0 Then
            varKontakt = Split(Cells(lngZeile, 9).Text, "|")
            lngStart = lngZeile + UBound(varKontakt) - 1
            Ausfuehren lngZeile, lngStart, 9
        End If
    Next lngZeile
    Columns("H:I").AutoFit
End Sub

Sub Ausfuehren(lngZ As Long, lngSt As Long, intSpalte As Integer)
    Rows(lngZ & ":" & lngSt).Insert
    Rows(lngSt + 1).Copy Rows(lngZ & ":" & lngSt)
    Cells(lngZ, intSpalte).Resize(UBound(varKontakt) + 1, 1).NumberFormat = "00000"
    Cells(lngZ, intSpalte).Resize(UBound(varKontakt) + 1, 1) = Application.Transpose(varKontakt) _

End Sub

GrußformelBeverly's Excel - Inn


  

Betrifft: AW: Variables Trennen von Spalten von: Jack_d
Geschrieben am: 23.09.2014 10:05:08

Hallo Meier

Ich hab mal ne Lösung gebastelt. wenn auch nicht die schönste, so funktioniert sie doch (Es fehlen derzeit aber noch die Überschriften, aber das Bekommst du auch hin

Grüße

Option Explicit

Sub Auflösen()

Dim LZeile As Long, Zeile As Long, ELZeile As Long, EZeile As Long
Dim A As String, B As String, C As String, D As String
Dim E As String, F As String, G As String, H As String
Dim I As String, J As String, K As String, L As String
Dim ArrH As Variant
Dim ArrI As Variant

With Worksheets("Original")
    LZeile = .Cells(Rows.Count, 1).End(xlUp).Row
    ELZeile = 2
    
    For Zeile = 2 To LZeile
        A = .Cells(Zeile, 1)
        B = .Cells(Zeile, 2)
        C = .Cells(Zeile, 3)
        D = .Cells(Zeile, 4)
        E = .Cells(Zeile, 5)
        F = .Cells(Zeile, 6)
        G = .Cells(Zeile, 7)
        H = .Cells(Zeile, 8)
        I = .Cells(Zeile, 9)
        J = .Cells(Zeile, 10)
        K = .Cells(Zeile, 11)
        L = .Cells(Zeile, 12)
        
        ArrH = Split(H, "|")
        ArrI = Split(I, "|")
        
        Select Case UBound(ArrH) > UBound(ArrI)
        
        Case Is = True
        
        
        With Worksheets("Formatiert FINAL")
                
            For EZeile = 0 To UBound(ArrH)
                .Cells(ELZeile, 1) = A
                .Cells(ELZeile, 2) = B
                .Cells(ELZeile, 3) = C
                .Cells(ELZeile, 4) = D
                .Cells(ELZeile, 5) = E
                .Cells(ELZeile, 6) = F
                .Cells(ELZeile, 7) = G
                .Cells(ELZeile, 8) = CStr("'" & ArrH(EZeile))
                .Cells(ELZeile, 9) = I
                .Cells(ELZeile, 10) = J
                .Cells(ELZeile, 11) = K
                .Cells(ELZeile, 12) = L
                
                ELZeile = ELZeile + 1
                
            Next EZeile
        End With
        
        Case Is = False
        
         With Worksheets("Formatiert FINAL")
                
            For EZeile = 0 To UBound(ArrI)
                .Cells(ELZeile, 1) = A
                .Cells(ELZeile, 2) = B
                .Cells(ELZeile, 3) = C
                .Cells(ELZeile, 4) = D
                .Cells(ELZeile, 5) = E
                .Cells(ELZeile, 6) = F
                .Cells(ELZeile, 7) = G
                .Cells(ELZeile, 8) = H
                .Cells(ELZeile, 9) = CStr("'" & ArrI(EZeile))
                .Cells(ELZeile, 10) = J
                .Cells(ELZeile, 11) = K
                .Cells(ELZeile, 12) = L
                
                ELZeile = ELZeile + 1
                
            Next EZeile
        End With
       End Select
       
      Next Zeile
End With
End Sub



  

Betrifft: AW: Variables Trennen von Spalten von: Luschi
Geschrieben am: 23.09.2014 12:06:42

Hallo Meier,

damit Du die Qual der Wahl hast, gebe ich hier auch noch meinen Senf dazu:

https://www.herber.de/bbs/user/92764.xlsm

Gruß von Luschi
aus klein-Paris


  

Betrifft: AW: Variables Trennen von Spalten von: Excel Neuling123
Geschrieben am: 23.09.2014 16:31:44

Hallo zusammen,

erstmals vielen dank euch dreien für die schnelle Hilfe! Alle 3 programme laufen wunderbar : )
Ich hab selber noch ein wenig an den Programmen rumgebastelt und hätte noch ein paar Fragen.

Zum Programm von Beverly:
Deinen Code verstehe ich leider nicht wirklich >.< Aber aus interesse, wie genau müsste ich es anpassen damit es das ergebnis in ein neues sheet kopiert sodass das originalsheet unverändert bleibt? Bin da auch mithilfe des debuggers nicht wirklich weitergekommen.

Zum Programm von Jack_d:
Dein Programm kann ich in weiten teilen nachvollziehen :) Hab das auch mit den überschriften und der fettung hinbekommen, jedoch leider relativ hässlich (sheet2.cells(...)) und dann Zellen weise mit Sheets("formatiert Final").Cells(1, 1).Font.Bold = True gefettet. Habe es also insgesammt 2*12 mal gemacht. Kann man irgendwie die komplette erste zeile aus dem ersten sheet kopieren und ihm sagen es ins zweite Fett reinzusetzen?

Zum Programm von Luschi:
Das mit dem Button fand ich echt beeindruckend. Auch die textausgabe am ende ist leichter als ich gedacht hätte ~~. Du hattest auch recht mit der Qual der Wahl!

zu guter letzt nochmal ein dickes danke an euch 3 :)


  

Betrifft: AW: Variables Trennen von Spalten von: Beverly
Geschrieben am: 23.09.2014 17:00:22

Hi,

hier nochmal der Code mit einigen Kommentaren - vielleicht wird dann klarer, was abläuft:

Dim varKontakt  ' Variable für die aufgesplitteten Zellinhalte

Sub Trennen()
    Dim lngLetzte As Long
    Dim lngZeile As Long
    Dim lngStart As Long
    ' letzte belegte Zeile in Spalte A
    lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 1)), _
        Cells(Rows.Count, 1).End(xlUp).Row, Rows.Count)
    ' Schleife von letzter belegten Zeile bis Zeile 2 aufwärts
    For lngZeile = lngLetzte To 2 Step -1
        ' Spalte H enthält "|"
        If InStr(Cells(lngZeile, 8), "|") > 0 Then
            ' Zellinhalt der laufenden Zeile aufsplitten
            varKontakt = Split(Cells(lngZeile, 8).Text, "|")
            ' Startzeile für den einzufügenden Bereich ermitteln
            ' aus laufender Zeile und Anzahl der gesplitteten Werte
            lngStart = lngZeile + UBound(varKontakt) - 1
            ' Unterprozedur aufrufen mit laufender Zeile, Startzeile und Spalte 8 (H)
            Ausfuehren lngZeile, lngStart, 8
        ' Spalte I enthält "|"
        ElseIf InStr(Cells(lngZeile, 9), "|") > 0 Then
            ' Zellinhalt der laufenden Zeile aufsplitten
            varKontakt = Split(Cells(lngZeile, 9).Text, "|")
            ' Startzeile für den einzufügenden Bereich ermitteln
            ' aus laufender Zeile und Anzahl der gesplitteten Werte
            lngStart = lngZeile + UBound(varKontakt) - 1
            ' Unterprozedur aufrufen mit laufender Zeile, Startzeile und Spalte 9 (I)
            Ausfuehren lngZeile, lngStart, 9
        End If
    Next lngZeile
    ' Spaltenbreite H:I anpassen
    Columns("H:I").AutoFit
End Sub

Sub Ausfuehren(lngZ As Long, lngSt As Long, intSpalte As Integer)
    ' Zeilen einfügen in Abhängigkeit von der Anzahl an aufzuteilenden Werten
    Rows(lngZ & ":" & lngSt).Insert
    ' Zeile kopieren und in die frei gewordenen Zeilen einfügen
    Rows(lngSt + 1).Copy Rows(lngZ & ":" & lngSt)
    ' Spalte H oder I im betreffenden Bereich mit Zahlenformat formatieren
    Cells(lngZ, intSpalte).Resize(UBound(varKontakt) + 1, 1).NumberFormat = "00000"
    ' Spalte H oder I im betreffenden Bereich die gesplitteten WErte eintragen
    Cells(lngZ, intSpalte).Resize(UBound(varKontakt) + 1, 1) = Application.Transpose(varKontakt) _

End Sub

GrußformelBeverly's Excel - Inn


 

Beiträge aus den Excel-Beispielen zum Thema "Variables Trennen von Spalten"