Følgende kode lagt i et modul (makro "Test") vil ligge rettet i kolonne C,
så indsæt en tom kolonne efter B
Option Explicit
Dim ws As Worksheet
Dim rColumn As Range, rcell As Range
Dim sOld() As String, sNew() As String, sTemp As String, sHolder As String
Dim iCount As Integer, iText As Integer, iCiffer As Integer
Sub Test()
Set ws = ActiveSheet
Set rColumn = Range("B2")
Set rColumn = Range(rColumn, rColumn.End(xlDown))
ReDim sOld(2 To rColumn.Rows.Count + 1)
ReDim sNew(2 To rColumn.Rows.Count + 1)
For Each rcell In rColumn
sOld(rcell.Row) = rcell.Value
Next
For iCount = 2 To rColumn.Rows.Count
iCiffer = 0
For iText = 1 To Len(sOld(iCount))
If IsNumeric(Mid(sOld(iCount), iText, 1)) Then
iCiffer = iCiffer + 1
sTemp = sTemp & Mid(sOld(iCount), iText, 1)
If iCiffer = 6 Then sHolder = sTemp
Else
If Not Mid(sOld(iCount), iText, 1) = "." Then
iCiffer = 0
sTemp = ""
End If
End If
Next
sNew(iCount) = Replace(sOld(iCount), Mid(sHolder, 1, 3) _
& "." & Mid(sHolder, 4), sHolder)
sTemp = ""
Next
Set rColumn = rColumn.Offset(0, 1)
For Each rcell In rColumn
rcell.Value = sNew(rcell.Row)
Next
End Sub
Jan
