Sub dollars()
Dim nb As Byte
strrow = "0123456789"
strCol = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
StrOp = ":;(+-*/^="
c = Replace([A1].Formula, "$", "")
Formula2 = ""
For t = 1 To Len(c)
X = "?"
If InStr(strrow, Mid(c, t, 1)) <> 0 Then
X = "0"
ElseIf InStr(strCol, Mid(c, t, 1)) <> 0 Then
X = "A"
ElseIf InStr(StrOp, Mid(c, t, 1)) <> 0 Then
X = "+"
End If
Formula2 = Formula2 & X
Next
st = 1: nb = 0
Do While st <> 0
st = InStr(st + 1, Formula2, "A0")
If st <> 0 And st > 1 Then
If Mid(Formula2, st - 1, 1) = "A" Then
If Mid(Formula2, st - 2, 1) <> "A" Then
c = Left$(c, st + nb - 2) & "$" & Mid$(c, st + nb - 1)
nb = nb + 1
c = Left$(c, st + nb) & "$" & Mid$(c, st + nb + 1)
nb = nb + 1
MsgBox c
End If
Else
c = Left$(c, st + nb - 1) & "$" & Mid$(c, st + nb)
nb = nb + 1
c = Left$(c, st + nb) & "$" & Mid$(c, st + nb + 1)
nb = nb + 1
MsgBox c
End If
End If
Loop
Range("A2").Formula = c
End Sub