Macro para obtener los números primos en Excel

Código:

Sub IB·NúmerosPrimos()

Dim n As Long, p() As String, x As Long, i As Long, b As Boolean, u As Long, r As Range, c As Range

On Error Resume Next

n = Application.InputBox("Introduce el número límite:", "INGENIERÍA & BURÓTICA", Type:=1)

On Error GoTo 0

If n <= 1 Then

Exit Sub

End If

On Error Resume Next

Set c = Application.InputBox("Selecciona la celda a partir de la cual se enlistarán los números primos", "INGENIERÍA & BURÓTICA", Type:=8)

On Error GoTo 0

If c Is Nothing Then

Exit Sub

End If

ReDim p(n - 1)

u = 0

For x = 2 To n

b = True

For i = 2 To Int(x ^ 0.5) + 1

If x Mod i = 0 Then

b = False

Exit For

End If

Next i

If b Or x = 2 Then

p(u) = CStr(x)

u = u + 1

End If

Next x

ReDim Preserve p(u - 1)

Set r = c.Resize(u, 1)

r.Value = WorksheetFunction.Transpose(p)

MsgBox "Existen " & u & " números primos hasta " & n, , "INGENIERÍA & BURÓTICA"

End Sub