Hvis i regneark: Rem Koden anbringes under det pågældende Ark (Højreklik på Ark / Vis programkode)
Dim antalRækker As Long, ræk As Long, ptAdresse As String, nyAdresse As String Dim postNrStart As Byte Public Sub adSkilPostNrBy() antalRækker = ActiveCell.SpecialCells(xlLastCell).Row
For ræk = 1 To antalRækker ptAdresse = Range("A" & ræk)
Rem Erstat @ med ø og fjern evt. "." nyAdresse = Replace(ptAdresse, "@", "ø") nyAdresse = Replace(nyAdresse, ".", "")
Rem fjern eller forekomster af DK & "-" If InStr(LCase(nyAdresse), "dk") > 0 Then nyAdresse = Trim(Replace(nyAdresse, "-", ""))
postNrStart = findPostNrStart(nyAdresse) If postNrStart > 0 Then nyAdresse = Mid(nyAdresse, postNrStart)
Rem indsætter redigeret adresse i kolonne B Range("B" & ræk) = nyAdresse End If End If Next ræk End Sub Private Function findPostNrStart(nyAdresse) Rem findposition for postnr (4 ciff efter hinanden) Dim p As Integer, fireTegn As String For p = 1 To Len(nyAdresse) - 3 fireTegn = Mid(nyAdresse, p, 4) If IsNumeric(fireTegn) = True And InStr(fireTegn, " ") = 0 Then findPostNrStart = p Exit Function End If Next p findPostNrStart = 0 End Function
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.