Fjern Bokstaver i postnummer

Hvis der altid er 4 tal:

Sub test()
Dim c As Range
For Each c In Selection
  c.Value = Right(c.Value, 4)
Next
End Sub

Formatter din postnummerkolonne som tekst.
Indsæt ny tom kolonne ved siden af.
Hvis din "gamle" post-nr.kolonne starter i f.eks. celle D1 markerer du nu celle E1 og vælger Indsæt Funktion ->Tekst ->HØJRE
Der popper nu en boks op hvor du først skal indsætte D1 og siden folde den ud igen og indsætte tallet 4 i den nederste linie. Tryk OK og nu skulle
f.eks. DK-2660 være ændret til 2600 i den nye indsatte kolonne.
Kopier så bare nedefter
m v h
HC

En anden mulighed er at bruge "Tekst til kolonner" i data-menuen.
Du kan så bruge "-" som det tegn der afgrænser.

Hej igen!

Denne kode virker perfekt men hvad nu hvis jeg gerne vil have at den fex tar data fra kolonne A i Ark1, laver kontrollen og derefter sætter resultatet ind i kolonne F i Ark2.
Er det noget som i kan hjælpe med? :-)
---------
Sub test()
Dim c As Range
For Each c In Selection
  c.Value = Right(c.Value, 4)
Next
End Sub
---------
På forhånd tak :-)

Option Explicit
Sub test()
Dim Rng As Range
Dim c As Range
Set Rng = Range(Cells(1, 1), Cells(65536, 1).End(xlUp).Address)
For Each c In Rng
  c.Offset(0, 5).Value = Right(c.Value, 4)
Next
End Sub

sorry, der er en fejl !!

Sub test()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Rng As Range
Dim c As Range
Dim x As Long
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("sheet2")
Set Rng = ws1.Range(Cells(1, 1), Cells(65536, 1).End(xlUp).Address)
For Each c In Rng
  x = x + 1
  ws2.Cells(x, 6).Value = Right(c.Value, 4)
Next
End Sub

Ok! Hvordan angiver jeg så at den skal starte i Sheet1 Kolonne E celle 3 og at resultatet skal sættes ind i Sheet2 Kolonne I celle 3.

Jeg fik også opfattelsen at den nu beregner fra venstre til højre og ikke fra celle 1, 2 osv.

Håber på fortsat hjælp :-) :-)

Sub test()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Rng As Range
Dim start As Range
Dim slut As Range
Dim c As Range
Dim x As Long

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("sheet2")
Set start = ws1.Range("E3")
Set slut = ws2.Range("I3")
Set Rng = ws1.Range(start.Address, ws1.Cells(65536, start.Column).End(xlUp).Address)
x = 0
For Each c In Rng
  slut.Offset(x, 0) = Right(c.Value, 4)
  x = x + 1
Next
End Sub

Simpethen bare genialt :-))) Takker for hjälpen!

Hvordan gør jeg så hvis jeg vil at den skal fjerne mellemrum og andre ugyldige tegn INDEN den laver beregningen?
---------------------------------
Sub Telefonnummer()
'
' Telefonnummer Makro
' Tar bort onödiga mellanrum, felaktiga tecken och allt som överstiger 8 tecken

Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Rng As Range
Dim start As Range
Dim slut As Range
Dim c As Range
Dim x As Long

Set ws1 = Sheets("Blad1")
Set ws2 = Sheets("Blad2")
Set start = ws1.Range("G3")
Set slut = ws2.Range("K3")
Set Rng = ws1.Range(start.Address, ws1.Cells(65536, start.Column).End(xlUp).Address)
x = 0
For Each c In Rng
  slut.Offset(x, 0) = Left(c.Value, 8)
  x = x + 1
Next
End Sub

Sub test()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Rng As Range
Dim start As Range
Dim slut As Range
Dim c As Range
Dim x As Long, i As Long
Dim st As String
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("sheet2")
Set start = ws1.Range("E3")
Set slut = ws2.Range("k3")
Set Rng = ws1.Range(start.Address, ws1.Cells(65536, start.Column).End(xlUp).Address)
x = 0
For Each c In Rng
    st = ""
  For i = 1 To Len(c)
    If IsNumeric(Mid(c, i, 1)) Then st = st + Mid(c, i, 1)
  Next
  slut.Offset(x, 0) = st
  x = x + 1
Next
End Sub

Den skal stadig også fjerne alle tegn der overstiger 8 :-)

slut.Offset(x, 0) = Left(c.Value, 8)

Det fatter jeg ikke......
Giv et par eksempler på dine postnumre

Undskyld men jeg mener telefonnumre. Har brugt dit script til det også.
Her er ett par.

86893301
58371103/25791103
43 532110
29 14 14 48

Der skal så fjernes alle tegn som overstiger 8 men først kontrolleres og fjernes for mellemrum

Håber at jeg ikke er for besværlig :-)

slut.Offset(x, 0) = Left(st, 8)

Nix, du er ikke for besværlig, jeg ville bare gerne heve vidst det med telefonnumrene :-)

Selvfølgelig skulle du det. Jeg har det bare lidt som om jeg forstyrrer jer heeeeele tiden :-)

Ærgeligt at jeg ikke kan give dig flere poæng :-(

Den siger at der er en komplimeringsfejl ved (st, 8)

slut.Offset(x, 0) = Left(st, 8)

bruger du den sidste kode jeg har skrevet ?

Yeps! Resultatet bliver:
23258536
46190217
4574421031
55 894 426
43551396
29240556
94 780 177
9 841 018 440 710 950

Jeg vil kun have 8 tal fra venstre resterende skal fjernes inden det skal alle mellemrum fjernes.

Jeg bruger denne kode
Sub test()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Rng As Range
Dim start As Range
Dim slut As Range
Dim c As Range
Dim x As Long, i As Long
Dim st As String
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("sheet2")
Set start = ws1.Range("G3")
Set slut = ws2.Range("k3")
Set Rng = ws1.Range(start.Address, ws1.Cells(65536, start.Column).End(xlUp).Address)
x = 0
For Each c In Rng
    st = ""
  For i = 1 To Len(c)
    If IsNumeric(Mid(c, i, 1)) Then st = st + Mid(c, i, 1)
  Next
  slut.Offset(x, 0) = Left(st, 8)
  x = x + 1
Next
End Sub


og når jeg kører den får jeg
23258536
46190217
45744210
55894426
43551396
29240556
94780177
98410184

Det gör jeg også nu.....dog stadig med mellemrum. Hvad kan det bero på?

22191668
97402631
55 894 426
43551396
29240556
54 780 177
98 410 184
58 380 844
66172520

Rickie, det kan ikke være rigtigt. Den cutter ved 8 cifre.
Det må bero på formateringen af cellerne. Kontroller lige at formatering er sat til Generel / Standard

Det var det! Underligt at jeg slet ikke har tjekket/tänkt på det.
Nu virker det.....bare genialt.

Tusind mange tak for hjälpen og ha en god aften :-)

:-)