Automatizujeme reporty: Ako dostať z textu PSČ a číslo domu

 

Najprv chcem poďakovať za námet, myslím si že je to často diskutovaný prípad v rámci reportov. Nebudem chodiť okolo horúcej kaše, vrhneme sa na prípad (Súbor s funkciami na stiahnutie dole):

Zadanie je jednoduché: z textu potrebujeme vrátiť PS4, Ulicu a Číslo domu.

Problém však nastáva vo forme toho textu. V realite nám možnosť Text To Columns nemusí postačovať, obzvlášť tak dostávame “ručne” naplnené tabuľky.

Začnem PSČ. Ak si pozrieme štruktúru PSČ, s istotou môžeme tvrdiť, že ak nájdeme v texte tri po sebe idúce znaky ako čísla, tak skoro s istotou sa nachádzame na PSČ. Tým pádom vytvoríme FOR cyklus, ktorý nájde takúto možnosť. potom stačí použiť hodnotu iteračného čísla z for cyklu ako začiatočné písmeno pri funkcii MID alebo ČÁST a máme PSČ (viď kód):

Function NajdiPSC(text As String)

Dim i As Integer

Const Cisla = "0123456789"

'Nájdem trojčíslie v texte
For i = 1 To Len(text)

    If InStr(Cisla, Mid(text, i, 1)) <> 0 And InStr(Cisla, Mid(text, i + 1, 1)) <> 0 And InStr(Cisla, Mid(text, i + 2, 1)) <> 0 Then
        'Vytrhnem z textu oblasť, začínajúca trojčíslím
        NajdiPSC = Mid(text, i, Len(text))
        Exit Function
    End If
       
Next i

End Function

Tak a máme PSČ, viď obrázok:

Teraz potrebujeme dostať číslo domu, čo bude trošku ťažší oriešok, no stručná metodika: nájdeme trojčíslie, ktoré bude prvá obmedzujúca podmienka pre FOR cyklus, teda i=1 až pozícia trojčíslia. V tomto obmedzení nájde prvé číslo, čím vznikne nové obmedzenie, teda i= poloha prvého čísla až po polohu trojčíslia. V tomto obmedzení budeme hľadať polohu prvého písmena. Následne použijeme funkciu MID alebo ČÁST, kde z textu vrátime časť od polohy prvého čísla až po polohu prvého písmenka, viď kód:

Function NajdiCisloDomu(text As String)

Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim l As Integer

Const Cisla = "0123456789"

'Nájdem trojčíslie v texte
For i = 1 To Len(text)

    If InStr(Cisla, Mid(text, i, 1)) <> 0 And InStr(Cisla, Mid(text, i + 1, 1)) <> 0 And InStr(Cisla, Mid(text, i + 2, 1)) <> 0 Then
        j = i
        GoTo dalej1
    End If
       
Next i

'Nájdem prvé číslo v texte
dalej1:
For i = 1 To j - 1

    If InStr(Cisla, Mid(text, i, 1)) <> 0 Then
        k = i
        GoTo dalej2
    End If
Next i

'Nájdem prvé písmenko v rámci obmedzenia prvé číslo - trojčíslie
dalej2:
For i = k + 1 To j - 1
    If InStr(Cisla, Mid(text, i, 1)) = 0 Then
    l = i
    GoTo dalej3
    End If
Next i

dalej3:

'Ošetrím ak popisné číslo je jednociferné
If l - k = 0 Then
    l = 1
Else
    l = l - k
End If

'Ošetrím ak nenájdem číslo domu
If k = 0 Then
    NajdiCisloDomu = ""
Else
    NajdiCisloDomu = Mid(text, k, l)
End If

End Function

Výsledok vyzerá nasledovne (ulicu alebo povedzme doplnkový text už nie je problém vyselektovať):

Súbor s funkciami stiahnete kliknutím na obrázok. Nezabudnite na Facebook, stačí kliknúť na logo a v prípade dotazov a podobných problémov ako je tento s radosťou odpoviem