Poradenství a kurzy
Perete se s Excelem? Zbavte sešity špíny a vyždímejte z Excelu maximum! Aviváž zdarma :-)
Algoritmy
Plné využití vzorců a nástrojů listu, aplikovaná matematika, VBA, netradiční řešení úloh, optimalizace běhu aplikací...
Programování
VBA a VB.NET, komentovaný a zarovnaný kód, ADO, WSH, WMI, API...
Štábní kultura
Čisté tabulky, infografika, uživatelsky přívětivé prostředí

Tabulka jako prostý text

Ačkoliv to dnes není tak aktuální jako dříve, stane se, že tabulku Excelu nemůžeme přiložit k e-mailu či příspěvku v diskusní skupině přímo jako sešit či obrazově a jsme odkázáni na prostý text. Oprášil jsem tedy starší článek. Vzorem nám bude obyčejná tabulka na obrázku.

Zdrojová tabulka

Zdrojová tabulka

A takto vypadá její převod do prosté textové podoby (okno Immediate editoru VBA):

Tabulka jako prostý text

Tabulka jako prostý text

Správné zarovnání je podmíněné neproporcionálním písmem (zde Courier New), kdy všechny znaky mají stejnou šířku.

Následuje převodní procedura VBA.

Sub TabulkaJakoText()

    Dim rngOblast As Range
    Dim rngSloupec As Range
    Dim rngRadek As Range
    Dim rngBunka As Range
    Dim strRadek As String
    Dim strRadekZnaky As String
    Dim strRet As String
    Dim i As Integer
    Dim j As Integer
    Dim intPocetRadku As Integer
    Dim intPocetSloupcu As Integer
    Dim intMaximum As Integer
    Dim aPoleDelky()

    'znaky oddělovačů
    Const cstrBunkaRoh As String = "+"
    Const cstrBunkaVer As String = "|"
    Const cstrBunkaHor As String = "-"

    'přiřazení vybrané oblasti do proměnné
    Set rngOblast = Selection

    'rozměry oblasti
    intPocetRadku = rngOblast.Rows.Count
    intPocetSloupcu = rngOblast.Columns.Count

    'redimenzování polé s délkami
    ReDim aPoleDelky(1 To intPocetSloupcu)

    'přiřazení úvodního znaku řádku
    strRadekZnaky = cstrBunkaRoh
   
    'pro každý sloupec...
    For Each rngSloupec In rngOblast.Columns
   
        i = i + 1
       
        'zjištění maximální délky obsahu buňky ve sloupci
        intMaximum = Len(rngSloupec.Cells(1).Text)
        For Each rngBunka In rngSloupec.Cells
            intMaximum = WorksheetFunction.Max(intMaximum, Len(rngBunka.Text))
        Next rngBunka
       
        aPoleDelky(i) = intMaximum
       
        'postupné sestavení řetězce oddělujícího řádku
        strRadekZnaky = strRadekZnaky & String(intMaximum, cstrBunkaHor) & _
            cstrBunkaRoh
           
    Next rngSloupec

    'přiřazení ohraničení shora a úvodního znaku buňky
    strRadek = strRadekZnaky & vbCrLf & cstrBunkaVer

    'sestavení jednotlivých řádků
    For Each rngRadek In rngOblast.Rows
        For Each rngBunka In rngRadek.Cells
            j = j + 1
            'řetězec buňky
            strRet = strRet & rngBunka.Text & Space(aPoleDelky(j) - _
                Len(rngBunka.Text)) & cstrBunkaVer
        Next rngBunka
        'řetězec řádku
        strRadek = strRadek & strRet & vbCrLf & strRadekZnaky & vbCrLf & _
            cstrBunkaVer
        'reset proměnných
        j = 0
        strRet = ""
    Next rngRadek

    'oříznutí
    strRadek = Left(strRadek, Len(strRadek) - 3)

    'výpis do okna Immediate (Ctrl+G)
    'adresa oblasti
    Debug.Print Selection.Address(False, False) & vbCrLf
    'textová tabulka
    Debug.Print strRadek

End Sub

V programovém kódu si člověk rozhodně vyhraje se slepováním textových řetězců a doplňování do patřičné šířky (funkce String a Space), nicméně nejtěžší část úlohy spočívá ve zjištění nejdelšího obsahu buňky ve sloupci. Stávající řešení se může zdát neefektivní, bohužel moc možností na výběr nemáme. Z buněk potřebujeme přebírat text (formátování ovlivní kupříkladu délku datumu), a nenašel jsem vhodný (maticový) vzorec předaný následně metodě Evaluate. Kód také neřeší sloučené buňky.

V příloze najdete ještě rozšířenou verzi procedury, jež přidává do tabulky hlavičku řádků a sloupců. V jejím provedení jsem již ponechal tabulku zleva a shora neuzavřenou, aby označení řádků a sloupců příliš nesplývalo s vlastním obsahem tabulky.

Tabulka jako prostý text - hlavička

Tabulka jako prostý text – hlavička

Příloha:
tabulka_jako_text.zip

LinkedIn Auto Publish Powered By : XYZScripts.com