以下是引用香川群子在2007-3-21 16:39:13的发言: Function ZS(R As Range) As Long Dim S(), Z() As Long ReDim S(R.Count) ReDim Z(1, 1) Z(0, 0) = 1 Z(1, 0) = 1 For i = 1 To R.Count S(i) = R.Cells(i) Next For i = 1 To R.Count If Not (S(i) = 0 Or S(i) = 1) Then Dn = 0 Do Until S(i) Mod 2 = 1 S(i) = S(i) / 2 Dn = Dn + 1 Loop If Dn > 0 And Dn > Z(1, 0) Then Z(0, 0) = 2 Z(1, 0) = Dn End If B = 1 Do Until S(i) < B ^ 2 B = B + 2 If S(i) Mod B = 0 Then Bn = 0 Do Until S(i) Mod B <> 0 S(i) = S(i) / B Bn = Bn + 1 Loop If Bn > 0 Then C = 0 K = UBound(Z, 2) For j = 1 To K If B = Z(0, j) Then If Bn > Z(1, j) Then Z(1, j) = Bn Exit For Else C = C + 1 If C = K Then Z(0, K) = B Z(1, K) = Bn ReDim Preserve Z(1, K + 1) End If End If Next End If End If Loop If S(i) > 1 Then C = 0 K = UBound(Z, 2) For j = 1 To K If S(i) = Z(0, j) Then Exit For Else C = C + 1 If C = K Then Z(0, K) = S(i) Z(1, K) = 1 ReDim Preserve Z(1, K + 1) End If End If Next End If End If Next i P = 1 For j = 1 To UBound(Z, 2) P = P * Z(0, j - 1) ^ Z(1, j - 1) Next ZS = P 'MsgBox "The Max LCM is " & Format(P, "#,##0") End Function 复杂化了,最小公倍数与最大公约数一般采用“辗转相除法”求解,如: Function LCM(ParamArray nums()) As Long Dim temp1 As Long, temp2 As Long, I As Long LCM = nums(0) For I = 1 To UBound(nums) temp1 = LCM temp2 = nums(I) LCM = LCM * temp2 Do If temp1 < temp2 Then temp = temp1 temp1 = temp2 temp2 = temp End If temp1 = temp1 Mod temp2 Loop While temp1 LCM = LCM \ temp2 Next End Function '调用: Sub macro1() MsgBox LCM(1, 2, 3, 4, 5, 6, 7, 8, 9, 10) End Sub |