MS Excel

€Ł мσşqμΐτσ napsal/a:

Dobrý den,
tady bych raději použil makro.
Option Explicit

Sub RozdelAdresy()
Dim ws As Worksheet
Dim posRdk As Long
Dim i As Long
Dim ulice As String
Dim popisne As String
Dim regEx As Object
Dim matches As Object

' Nastavení listu, kde jsou data
Set ws = ThisWorkbook.Sheets(1) ' Změň číslo listu, pokud je potřeba

With ws
' Najde poslední řádek ve sloupci D
posRdk = .Cells(.Rows.Count, "D").End(xlUp).Row

' Vytvoření RegEx objektu
Set regEx = CreateObject("VBScript.RegExp")
regEx.Global = True
regEx.Pattern = "^(.*?)(\d.*)$"

' Prochází všechny řádky ve sloupci D
For i = 2 To posRdk ' Předpokládáme, že hlavička je na řádku 1
If .Cells(i, "D").Value <> "" Then
' Zpracuje adresu pomocí RegEx
If regEx.Test(.Cells(i, "D").Value) Then
Set matches = regEx.Execute(.Cells(i, "D").Value)
ulice = Trim(matches(0).SubMatches(0))
popisne = Trim(matches(0).SubMatches(1))
Else
ulice = .Cells(i, "D").Value
popisne = ""
End If

' Zapíše rozdělené části do sloupců D a R
.Cells(i, "D").Value = ulice
.Cells(i, "R").Value = popisne
End If
Next i
End With

MsgBox "Rozdělení adres dokončeno!", vbInformation
End Sub