Ako rozdeliť text oddelený ručným zalomením do viacerých riadkov?

Oslovila ma študentka, ktorá sa na praxi stretla so špecifickým problémom. K dispozícii má tabuľku, ktorá vyzerá približne takto:

Samozrejme, reálne údaje mi poskytnúť nemohla. 🙂

Údaje v stĺpcoch B, C, D sú v jednotlivých bunkách oddelené ručným zalomením riadka. Písali sme si o ňom v tomto článku.

Čo potrebuje?

Potrebuje jednotlivé údaje rozdeliť do riadkov a zároveň pridať pred stĺpec B 1 stĺpec, v ktorom bude uvedené poradie kontaktných osôb – 1st, 2nd…

Môžeme si pomôcť aj základnými zručnosťami a postupne:

• vložiť pod príslušný riadok potrebný počet prázdnych riadkov;
• vložiť stĺpec;
• postupne po jednom údaje všetko kopírovať do príslušných buniek, aby sme dosiahli požadovaný stav.

Asi takýto: 🙂

Tento spôsob je ale strááášne pomalý… 🙁

Čo s tým?

🙂 Pomôže nám VBA a vytvorenie makra, ktoré všetko spraví za nás. 🙂

K podrobnému vysvetleniu kódu sa dostanem snáď neskôr, teraz teda samotné makro (VBA – skratka ALT+F11):

Sub pridajriadky2()
    Dim i As Integer
    Dim PoziciaZalomenia(1 To 50) As Integer
    Dim PoziciaZalomeniaEmail(1 To 50) As Integer
    Dim PoziciaZalomeniaTelef(1 To 50) As Integer
    Dim PocetZalomeni As Integer
    Dim RozsahBuniek As Range
    Dim BunkaSKontaktmi As Range
    Set RozsahBuniek = Selection
    ActiveCell.EntireColumn.Insert
    For Each BunkaSKontaktmi In RozsahBuniek
        PocetZalomeni = Len(BunkaSKontaktmi.Text) - Len(Replace(BunkaSKontaktmi.Text, Chr(10), ""))
        If PocetZalomeni > 0 Then
            For i = 1 To PocetZalomeni
                BunkaSKontaktmi.Offset(1, 0).EntireRow.Insert
            Next i
            PoziciaZalomenia(1) = InStr(BunkaSKontaktmi.Text, Chr(10))
            PoziciaZalomeniaEmail(1) = InStr(BunkaSKontaktmi.Offset(0, 1).Value, Chr(10))
            PoziciaZalomeniaTelef(1) = InStr(BunkaSKontaktmi.Offset(0, 2).Value, Chr(10))
            If PocetZalomeni > 1 Then
                For i = 1 To PocetZalomeni - 1
                    PoziciaZalomenia(i + 1) = InStr(PoziciaZalomenia(i) + 1, BunkaSKontaktmi.Text, Chr(10))
                    PoziciaZalomeniaEmail(i + 1) = InStr(PoziciaZalomeniaEmail(i) + 1, BunkaSKontaktmi.Offset(0, 1).Value, Chr(10))
                    PoziciaZalomeniaTelef(i + 1) = InStr(PoziciaZalomeniaTelef(i) + 1, BunkaSKontaktmi.Offset(0, 2).Value, Chr(10))
                Next i
                For i = 1 To PocetZalomeni - 1
                    If Left(BunkaSKontaktmi.Text, 1) > 0 Then
                        BunkaSKontaktmi.Offset(i, -1).Value = Mid(BunkaSKontaktmi.Text, PoziciaZalomenia(i) + 1, 3)
                        BunkaSKontaktmi.Offset(i, 0).Value = Mid(BunkaSKontaktmi.Text, PoziciaZalomenia(i) + 5, PoziciaZalomenia(i + 1) - PoziciaZalomenia(i) - 5)
                        BunkaSKontaktmi.Offset(i, 1).Value = Mid(BunkaSKontaktmi.Offset(0, 1).Value, PoziciaZalomeniaEmail(i) + 1, PoziciaZalomeniaEmail(i + 1) - PoziciaZalomeniaEmail(i) - 1)
                        BunkaSKontaktmi.Offset(i, 2).Value = Mid(BunkaSKontaktmi.Offset(0, 2).Value, PoziciaZalomeniaTelef(i) + 1, PoziciaZalomeniaTelef(i + 1) - PoziciaZalomeniaTelef(i) - 1)
                    End If
                Next i
                If Left(BunkaSKontaktmi.Text, 1) > 0 Then
                    BunkaSKontaktmi.Offset(0, -1).Value = Left(BunkaSKontaktmi.Text, 3)
                    BunkaSKontaktmi.Offset(PocetZalomeni, -1).Value = Mid(BunkaSKontaktmi.Text, PoziciaZalomenia(PocetZalomeni) + 1, 3)
                    BunkaSKontaktmi.Offset(PocetZalomeni, 0).Value = Mid(BunkaSKontaktmi.Text, PoziciaZalomenia(PocetZalomeni) + 5, Len(BunkaSKontaktmi.Text) - PoziciaZalomenia(PocetZalomeni) - 4)
                    BunkaSKontaktmi.Offset(0, 0).Value = Mid(BunkaSKontaktmi.Text, 5, PoziciaZalomenia(1) - 5)
                    BunkaSKontaktmi.Offset(PocetZalomeni, 1).Value = Mid(BunkaSKontaktmi.Offset(0, 1).Value, PoziciaZalomeniaEmail(PocetZalomeni) + 1, Len(BunkaSKontaktmi.Offset(0, 1).Value) - PoziciaZalomeniaEmail(PocetZalomeni) - 1)
                    BunkaSKontaktmi.Offset(PocetZalomeni, 2).Value = Mid(BunkaSKontaktmi.Offset(0, 2).Value, PoziciaZalomeniaTelef(PocetZalomeni) + 1, Len(BunkaSKontaktmi.Offset(0, 2).Value) - PoziciaZalomeniaTelef(PocetZalomeni) - 1)
                    BunkaSKontaktmi.Offset(0, 1).Value = Left(BunkaSKontaktmi.Offset(0, 1).Value, PoziciaZalomeniaEmail(1) - 1)
                    BunkaSKontaktmi.Offset(0, 2).Value = Left(BunkaSKontaktmi.Offset(0, 2).Value, PoziciaZalomeniaTelef(1) - 1)
                End If
            ElseIf PocetZalomeni = 1 Then
                If Left(BunkaSKontaktmi.Text, 1) > 0 Then
                    BunkaSKontaktmi.Offset(0, -1).Value = Left(BunkaSKontaktmi.Text, 3)
                    BunkaSKontaktmi.Offset(1, -1).Value = Mid(BunkaSKontaktmi.Text, PoziciaZalomenia(1) + 1, 3)
                    BunkaSKontaktmi.Offset(1, 0).Value = Mid(BunkaSKontaktmi.Text, PoziciaZalomenia(1) + 5, Len(BunkaSKontaktmi.Text) - PoziciaZalomenia(1))
                    BunkaSKontaktmi.Offset(0, 0).Value = Mid(BunkaSKontaktmi.Text, 5, PoziciaZalomenia(1) - 5)
                    BunkaSKontaktmi.Offset(1, 1).Value = Mid(BunkaSKontaktmi.Offset(0, 1).Value, PoziciaZalomeniaEmail(1) + 1, Len(BunkaSKontaktmi.Offset(0, 1).Value) - PoziciaZalomeniaEmail(1) - 1)
                    BunkaSKontaktmi.Offset(1, 2).Value = Mid(BunkaSKontaktmi.Offset(0, 2).Value, PoziciaZalomeniaTelef(1) + 1, Len(BunkaSKontaktmi.Offset(0, 2).Value) - PoziciaZalomeniaTelef(1) - 1)
                    BunkaSKontaktmi.Offset(0, 1).Value = Left(BunkaSKontaktmi.Offset(0, 1).Value, PoziciaZalomeniaEmail(1) - 1)
                    BunkaSKontaktmi.Offset(0, 2).Value = Left(BunkaSKontaktmi.Offset(0, 2).Value, PoziciaZalomeniaTelef(1) - 1)
                End If
            Else
                If Left(BunkaSKontaktmi.Text, 1) > 0 Then
                    BunkaSKontaktmi.Offset(0, -1).Value = Left(BunkaSKontaktmi.Text, 3)
                    BunkaSKontaktmi.Offset(0, 0).Value = Mid(BunkaSKontaktmi.Text, 5, PoziciaZalomenia(1) - 5)
                End If
            End If
        End If
        
    Next BunkaSKontaktmi
End Sub

A ešte súbor na vyskúšanie… Stačí označiť bunky v stĺpci B, klávesovou skratkou ALT+F8 sprístupniť makrá a spustiť nami vytvorené makro.