edit vba code for display In Exponential Form

[abbccc]

i find a v.b.a code for decomposition into prime
but the result is same string
i want display In Exponential Form
please edit v.b.a code


v.b.a code is


Sub Prime()
Dim n As Long, i As Long, s As String
n = ActiveCell
i = 2
Do While n >= i
If n Mod i = 0 Then
s = s & " * " & CStr(i)
n = n \ i
Else
i = i + 1
End If
Loop
ActiveCell.Offset(0, 1).Value = Mid(s, 4)
End Sub

for example

9937

[abbccc]

help

[abbccc]

:banghead: :banghead: :banghead:
:( :( :( :(
help help help

[abbccc]

please edit vba code or give me a other vba code

[p45cal]

duplicate of http://vbaexpress.com/forum/showthread.php?t=46060 and cross-posted http://www.xtremevbtalk.com/showthread.php?t=325884.

Try:Sub Prime3()
Dim n, i As Long, s As String, Res()
ReDim Res(0 To 0), ExpoLen(0 To 0), ExpoPosn(0 To 0)
n = ActiveCell
i = 2
Do While n >= i
If n Mod i = 0 Then
ReDim Preserve Res(0 To UBound(Res) + 1)
Res(UBound(Res)) = i
n = n \ i
Else
i = i + 1
End If
Loop
myexponent = 1
For i = 1 To UBound(Res)
If i < UBound(Res) Then
If Res(i) = Res(i + 1) Then
myexponent = myexponent + 1
Else
'Stop
If myexponent > 1 Then
ReDim Preserve ExpoPosn(0 To UBound(ExpoPosn) + 1)
ReDim Preserve ExpoLen(0 To UBound(ExpoLen) + 1)
mystring = mystring & "*" & Res(i)
If Left(mystring, 1) = "*" Then mystring = Mid(mystring, 2)
ExpoPosn(UBound(ExpoPosn)) = Len(mystring) + 1
ExpoLen(UBound(ExpoLen)) = Len(myexponent)
mystring = mystring & myexponent
myexponent = 1
Else
mystring = mystring & "*" & Res(i)
End If
End If
Else
'last or only value
If myexponent > 1 Then
ReDim Preserve ExpoPosn(0 To UBound(ExpoPosn) + 1)
ReDim Preserve ExpoLen(0 To UBound(ExpoLen) + 1)
mystring = mystring & "*" & Res(i)
If Left(mystring, 1) = "*" Then mystring = Mid(mystring, 2)
ExpoPosn(UBound(ExpoPosn)) = Len(mystring) + 1
ExpoLen(UBound(ExpoLen)) = Len(myexponent)
mystring = mystring & myexponent
Else
mystring = mystring & "*" & Res(i)
If Left(mystring, 1) = "*" Then mystring = Mid(mystring, 2)
End If
End If
Next i
ActiveCell.Offset(, 2) = mystring
For i = 1 To UBound(ExpoLen)
ActiveCell.Offset(, 2).Characters(Start:=ExpoPosn(i), Length:=ExpoLen(i)).Font.Superscript = True
Next i
End Sub
This is not perfect, there is a least one bug - working on it.

[p45cal]

Bug fixed:Sub Prime3()
Dim n, i As Long, s As String, Res()
ReDim Res(0 To 0), ExpoLen(0 To 0), ExpoPosn(0 To 0)
n = ActiveCell
i = 2
Do While n >= i
If n Mod i = 0 Then
ReDim Preserve Res(0 To UBound(Res) + 1)
Res(UBound(Res)) = i
n = n \ i
Else
i = i + 1
End If
Loop
myexponent = 1
For i = 1 To UBound(Res)
If i < UBound(Res) Then
If Res(i) = Res(i + 1) Then
myexponent = myexponent + 1
Else
'Stop
If myexponent > 1 Then
ReDim Preserve ExpoPosn(0 To UBound(ExpoPosn) + 1)
ReDim Preserve ExpoLen(0 To UBound(ExpoLen) + 1)
mystring = mystring & "*" & Res(i)
If Left(mystring, 1) = "*" Then mystring = Mid(mystring, 2)
ExpoPosn(UBound(ExpoPosn)) = Len(mystring) + 1
ExpoLen(UBound(ExpoLen)) = Len(myexponent)
mystring = mystring & myexponent
myexponent = 1
Else
mystring = mystring & "*" & Res(i)
End If
End If
Else
'last or only value
If myexponent > 1 Then
ReDim Preserve ExpoPosn(0 To UBound(ExpoPosn) + 1)
ReDim Preserve ExpoLen(0 To UBound(ExpoLen) + 1)
mystring = mystring & "*" & Res(i)
If Left(mystring, 1) = "*" Then mystring = Mid(mystring, 2)
ExpoPosn(UBound(ExpoPosn)) = Len(mystring) + 1
ExpoLen(UBound(ExpoLen)) = Len(myexponent)
mystring = mystring & myexponent
Else
mystring = mystring & "*" & Res(i)
If Left(mystring, 1) = "*" Then mystring = Mid(mystring, 2)
End If
End If
Next i
With ActiveCell.Offset(, 2)
.NumberFormat = "@"
.Value = mystring
For i = 1 To UBound(ExpoLen)
.Characters(Start:=ExpoPosn(i), Length:=ExpoLen(i)).Font.Superscript = True
Next i
End With
End Sub

[abbccc]

:clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :rotlaugh: :rotlaugh: :friends: :friends: :friends:
Thank you very much Thank you very much Thank you very much Thank you very much Thank you very much
:clap: :clap: :clap: :clap: :clap: :clap: :clap: :clap: :rotlaugh: :rotlaugh: :friends: :friends: :friends:

You're the best teacher I
You're the best teacher I
You're the best teacher I

[abbccc]

p45cal :
You're the best teacher I

You're the best teacher I
You're the best teacher I

[abbccc]

Is this code works for any number

[abbccc]

help
Is this code works for any number

[abbccc]

help

[p45cal]

Is this code works for any numberUp to 2,147,483,647
It may take a few minutes if the number is large and prime.

[abbccc]

Thank you
p45cal :
You're the best teacher I