57172_bez-nazvu.png
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 Subcitovat
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 Subcitovat
\n
RSS nejnovější články