[求助]计算最小公倍数 －急啊

Dong2000

紧急求助, 请问怎样将A列中相同名称的B列数量的最小公倍数写入C列，顺便将相应的最大数写入D列，可以写在首行或末行。计算结果已经表示在样本文件中。谢谢！

FGfS2zW5.zip (4.5 KB, 下载次数: 5)

2007-3-20 19:13 上传

点击文件名下载附件
[求助]计算最小公倍数 －急啊

liujy

用LCM函数可求最小公倍数：

ynsup9b5.rar (2.55 KB, 下载次数: 34)

2007-3-20 19:26 上传

点击文件名下载附件
[求助]计算最小公倍数 －急啊

Dong2000

楼上高手，不得不服啊。

多谢！

liujy

QUOTE:

以下是引用Dong2000在2007-3-20 20:23:40的发言：

楼上高手，不得不服啊。

多谢！

其实这没有什么！只要你也弄本函数手册读过，知道有LCM()这个函数可以求最小公倍数，这个问题就不是很难了。

建议有系统地浏览一下所有的函数，脑子里留点印象，要用的时候就可以通过Excel处带的帮助临时学习其用法。

[此贴子已经被作者于2007-3-21 8:37:19编辑过]

f_qc

看来函数确实需要多看看，想着用代码来做了

香川群子

虽然Excel加载宏中已有现成公式，但是如果你能编写自己的代码完成这样的任务，也是好事啊。

可以锻炼自己的能力噢。

1。建立空的质数数组；

2。把引用范围内的数逐个压入数据数组；

2。对数据组内每个数逐个分拆为质数；

3。把取得的质数，和已保存在质数数组内的已知质数逐个比较，

   如为已知质数则舍弃，如为新质数则加入；

4。重复2-3到处理完所有数；

5。输出所有已知有效质数的乘积。

以上。

香川群子

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

nickxie

即生喻，何生亮

northwolves

QUOTE:

以下是引用香川群子在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

香川群子

太感谢了。

好的思路胜过苦干。

好的思路来源于关注、学习、探索、积累、……