June 2018 Update

Task/Amicable-pairs/VBA/amicable-pairs.vba

@@ -0,0 +1,38 @@
+Option Explicit
+
+Public Sub AmicablePairs()
+Dim a(2 To 20000) As Long, c As New Collection, i As Long, j As Long, t#
+    t = Timer
+    For i = LBound(a) To UBound(a)
+        'collect the sum of the proper divisors
+        'of each numbers between 2 and 20000
+        a(i) = S(i)
+    Next
+    'Double Loops to test the amicable
+    For i = LBound(a) To UBound(a)
+        For j = i + 1 To UBound(a)
+            If i = a(j) Then
+                If a(i) = j Then
+                     On Error Resume Next
+                     c.Add i & " : " & j, CStr(i * j)
+                     On Error GoTo 0
+                     Exit For
+                End If
+            End If
+        Next
+    Next
+    'End. Return :
+    Debug.Print "Execution Time : " & Timer - t & " seconds."
+    Debug.Print "Amicable pairs below 20 000 are : "
+    For i = 1 To c.Count
+        Debug.Print c.Item(i)
+    Next i
+End Sub
+
+Private Function S(n As Long) As Long
+'returns the sum of the proper divisors of n
+Dim j As Long
+    For j = 1 To n \ 2
+        If n Mod j = 0 Then S = j + S
+    Next
+End Function