Kolom wijzigen door twee punten per cel toe te voegen aan bestaande tekst

[Robert Smidt]

Beste Helpmij'ers,

Ik ben al een tijd bezig om in kolom A alle cellen (die zijn gevuld) te voorzien van een punt rechts t.o.v. het eerste karakter en een punt rechts t.o.v. het derde karakter. De code werkt wel als ik per cel deze wijziging wil doorvoeren, echter niet in combinatie om de hele kolom in één keer te wijzigen.

Alvast heel erg bedankt.

Robert


Bekijk bijlage test sjabloon.xlsm

 

[SjonR]

Doet dit wat je wil?

Sub test()
Application.EnableEvents = False
For Each cl In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    If cl <> "" Then
    If Len(cl) = 7 Then
        
        Dim P(2) As String
        P(0) = Left(cl, 1)
        P(1) = Mid(cl, 2, 2)
        P(2) = Right(cl, 4)
        cl.Value = Join(P, ".")
    
    End If
End If
Next
Application.EnableEvents = True
End Sub

 

[Robert Smidt]

Dit is precies wat ik bedoel...heel erg bedankt...was ik wederom nooit zelf opgekomen.

 

[snb]

Sub M_snb()
   sn = [A1:A20]
   For j = 1 To UBound(sn)
     sn(j, 1) = Format(sn(j, 1), "@.@@.@")
   Next
   
   [A1:A20].Offset(, 2) = sn
End Sub

of

Sub M_snb()
   [A1:A20].Offset(, 4) = [index(left(A1:A20,1)&"." & mid(A1:A20,2,2) & "." & mid(A1:A20,4,len(A1:A20)),)]
End Sub