Opdel celle i delelementer

I en kolonne står adresser på formen

Åboulevarden 23 st.th
Ågade 18A 3.
Bygaden 22
osv.

Det skal opdeles i enkelte celler på denne form

Nedenstående makro løses de fleste skrivevarianter af adressen.

Sub AdrTilKol()
    For Each c In Range("B2:B2000").Cells
        If Not IsEmpty(c.Value) Then
            adr = c.Value
            If Instr(adr, " ") = InstrRev(adtr, " ") And IsNumeric(Instr(adr, " ") + 1) Then
                vej = Mid(adr, 1, Instr(adr, " ")
                husnr = mid(adr, Instr(adr(, " ") + 1, Len(adr)
                GoTo skriv
            End if
            For i = 1 To Len(adr)
                If IsNumeric(Mid(adr, i, 1)) Then
                    vej = Mid(adr, 1, i - 1)
                    Exit For
                End If
 
                rest = Mid(adr, i + 1, Len(adr))
                For h = 1 To Len(rest)
                    If Not IsNumeric(Mid(rest, h, 1)) Then
                        husnr = Mid(rest, 1, h - 1)
                        Exit For
                    End If
                Next h
                sidst = Mid(rest, h, Len(rest))
            Next i
        End If
skriv:
        c.Offset(0, 1).Value = vej
        c.Offset(0, 2).Value = husnr
        c.Offset(0, 3).Value = sidst
    Next c
End Sub

-Tilbage til makroer -
- Tilbage til Excel  -