MS Excel

Prosím o radu, potřebuji oddělit PSČ do nových buňek, vzhledem k tomu, že se nachází v buňce pokaždé na jiném místě, nevím jak na to. Moc díky. V příloze jsou příklady, jak to může vypadat.

Zaslat odpověď >

Strana: 1 2 další »

Pavlus(17.10.2012 23:13)#009937

No, ono to asi ani v této situaci nepůjde .-).
V tom souboru je nějaká změť textu, která je pokaždé jiná a nevidím tam žádné kritérium, jak z toho to PSČ vytáhnout. Pokud by třeba před každým PSČ bylo napsaný "PSČ", tak to by byla jiná věc, ale takhle to nepůjde.

Jinak tam máš třeba PSČ ve tvaru "12345" a "123 45", a už jenom tohle to dosti komplikuje. Muselo by se to nějak sjednotit...
P.citovat

zdeny(17.10.2012 23:30)#009939

ok, ta varianta 123 45, tam je vyjmečně, takže to by šlo jen pro 12345, bude to tak ok?citovat

lopi007(18.10.2012 11:50)#009948

Možná přez regulární výraz ale netuším jestli to VBA podporuje

citovat

Milan-D(18.10.2012 12:50)#009952

Leda tak kazdy ten retezec prohnat smyckou, ktera bude zkoumat, jestli 5 znaku po sobe je cislo (VBA funkce IsNumeric a MID). Pokud nekdo dopustil takovou databazi, tak sorry, niceho jineho se neda chytit
treba tahkhe:
Option Explicit

Sub VyjmiPSC()
Dim i As Integer

For i = 1 To 4
Cells(i, "B") = ExtrahujPSC(Cells(i, "A").Value)
Next i

End Sub

Function ExtrahujPSC(strText As String) As String
Dim j As Integer, iLen As Integer
Dim strX As String, strY As String

'odstran pocatecne a koncove mezery
strText = Trim(strText)

'delka vyrazu
iLen = Len(strText)

'odstran mezery
On Error Resume Next
For j = 1 To iLen
If Mid(strText, j, 1) = " " Then
strText = Left(strText, j - 1) & Right(strText, Len(strText) - j)
End If
Next j
On Error GoTo 0

'jeste jednou sejmi delku vyrazu
iLen = Len(strText)

For j = 1 To iLen - 4
strX = Mid(strText, j, 5)
If IsNumeric(strX) Then
'podminka pro vylouceni desetinnych vyrazu:
If CStr(CLng(strX * 1)) = strX Then
ExtrahujPSC = Left(strX, 3) & " " & Right(strX, 2)
Exit Function
End If
End If
Next j

End Functioncitovat

marjankaj(18.10.2012 13:09)#009953

Public Function psc(text As String) As String
Dim a As String
psc=""
text = Replace(text, " ", "", , , 1)
For i = 1 To Len(text)
a = Mid(text, i, 5)
If IsNumeric(a) Then
If a Like "#####" Then
psc = a
Exit Function
End If
End If
Next i
End Functioncitovat

zdeny(18.10.2012 13:23)#009954

Super, ještě prosím zda by to psč bylo vyjmuté,tzn aby bylo pouze v samostatné buňce,půjde to?citovat

Milan-D(18.10.2012 13:25)#009955

Zdeny - vzdyt to vytahne psc do samostatnych bunek ve sloupci B.
Pouzij cely kod tak jak to tam mam a spusti Sub VyjmiPSC(kurzor nekam do Sub a zmackni F5). Klidne si volej marianovu funkci, je ucinnejsi

Marian:
Replace + Like "#####" = paradacitovat

marjankaj(18.10.2012 14:25)#009960

Milan: trochu si ma nakopol aj ty s tým IsNumeric.

Ale dokonalé to nie je. Ak by tam bolo napríklad pred PSČ telefonne číslo, tak vyberie telefónne číslo. Ale to už testovať asi neviem.citovat

zdeny(18.10.2012 14:28)#009961

asi dělám něco špatně, viz příloha

Příloha: zip