'Benötigt werden: 1 Label, 1 Listbox
Option Explicit
 
Private Sub Form_Activate()
 
Dim A%, B%, C%, D%, E%, F%, S1%
Dim Min%, Max%, Summe() As Double, T1!, T2!
 
T1 = Timer
Min = 1 + 2 + 3 + 4 + 5 + 6
Max = 49 + 48 + 47 + 46 + 45 + 44
ReDim Summe(Min To Max)
For A = 1 To 49
  For B = A + 1 To 49
    Label1.Caption = A & "/" & B
    DoEvents
    For C = B + 1 To 49
      For D = C + 1 To 49
        For E = D + 1 To 49
          For F = E + 1 To 49
            S1 = A + B + C + D + E + F
            Summe(S1) = Summe(S1) + 1
          Next F
        Next E
      Next D
    Next C
  Next B
Next A
List1.Clear
For A = 1 To 49
  For B = A + 1 To 49
    Label1.Caption = A & "/" & B
    DoEvents
    For C = B + 1 To 49
      For D = C + 1 To 49
        For E = D + 1 To 49
          For F = E + 1 To 49
            S1 = A + B + C + D + E + F
            If Summe(S1) * S1 = CDbl(A) * B * C * D * E * F Then
              List1.AddItem A & " / " & B & " / " & C & " / " & D & " / " & E & _
                " / " & F
            End If
          Next F
        Next E
      Next D
    Next C
  Next B
Next A
T2 = Timer
Label1.Caption = Format((T2 - T1), "0.00") & " Sek."
 
End Sub

'Benötigt werden: 1 Label, 1 Listbox
Option Explicit
 
Private Sub Form_Activate()
 
Dim A%, B%, C%, D%, E%, F%, i%, Min%, Max%, Summe() As Double
Dim S1%, S2%, S3%, S4%, S5%, T1!, T2!
Dim P1&, P2&, P3 As Double, P4 As Double
 
T1 = Timer
Min = 1 + 2 + 3 + 4 + 5 + 6
Max = 49 + 48 + 47 + 46 + 45 + 44
ReDim Summe(Min To Max)
For A = 1 To 49
  For B = A + 1 To 49
    S1 = A + B
    Label1.Caption = A & "/" & B
    DoEvents
    For C = B + 1 To 49
      S2 = S1 + C
      For D = C + 1 To 49
        S3 = S2 + D
        For E = D + 1 To 49
          S4 = S3 + E
          For F = E + 1 To 49
            S5 = S4 + F
            Summe(S5) = Summe(S5) + 1
          Next F
        Next E
      Next D
    Next C
  Next B
Next A
For i = Min To Max
  Summe(i) = Summe(i) * i
Next i
List1.Clear
For A = 1 To 49
  For B = A + 1 To 49
    P1 = A * B
    S1 = A + B
    Label1.Caption = A & "/" & B
    DoEvents
    For C = B + 1 To 49
      P2 = P1 * C
      S2 = S1 + C
      For D = C + 1 To 49
        P3 = P2 * D
        S3 = S2 + D
        For E = D + 1 To 49
          P4 = P3 * E
          S4 = S3 + E
          For F = E + 1 To 49
            If Summe(S4 + F) = P4 * F Then
              List1.AddItem A & " / " & B & " / " & C & " / " & D & " / " & E & _
                " / " & F
            End If
          Next F
        Next E
      Next D
    Next C
  Next B
Next A
T2 = Timer
Label1.Caption = Format((T2 - T1), "0.00") & " Sek."
 
End Sub