[已解决]助求14X+21Y+26Z=488正整数解？

CheryBTL

telexon 发表于 2013-10-21 22:52
dearS： 怎么提示错误，“溢出”，我实在不懂

是什么情况？上个附件上来看看？是不是改的数据太大了？

telexon

CheryBTL 发表于 2013-10-21 22:53
是什么情况？上个附件上来看看？是不是改的数据太大了？

谢谢了，我调好了，明天请帮我做二元的，请看附件

CheryBTL

适合二元或三元都行：

1. Sub ep()
   
2.     Dim i As Integer, j As Integer, k As Integer, Rnum As Integer
   
3.     Dim re()
   
4.     Dim Totalsum As Integer, X1 As Integer, X2 As Integer, X3 As Integer
   
5.     X1 = Sheets(1).Range("d2")
   
6.     X2 = Sheets(1).Range("e2")
   
7.     X3 = Sheets(1).Range("f2")
   
8.     Totalsum = Sheets(1).Range("g2")
   
9. 
   
10.     For i = 0 To Totalsum / X1
    
11.         For j = 0 To Totalsum / X2
    
12.             If X3 > 0 Then
    
13.                 For k = 0 To Totalsum / X3
    
14.                     If Totalsum = X1 * i + X2 * j + X3 * k Then
    
15.                         m = m + 1
    
16.                         ReDim Preserve re(1 To 3, 1 To m)
    
17.                         re(1, m) = i
    
18.                         re(2, m) = j
    
19.                         re(3, m) = k
    
20.                     End If
    
21.                 Next k
    
22.             Else
    
23.                 If Totalsum = X1 * i + X2 * j Then
    
24.                     m = m + 1
    
25.                     ReDim Preserve re(1 To 3, 1 To m)
    
26.                     re(1, m) = i
    
27.                     re(2, m) = j
    
28.                 End If
    
29.             End If
    
30.         Next j
    
31.     Next i
    
32.     Sheets(1).[a1].Resize(UBound(re, 2), 3) = Application.Transpose(re)
    
33. End Sub
    

复制代码

telexon

CheryBTL 发表于 2013-10-22 07:55
适合二元或三元都行：

真的太感谢您了。每天给我省了1个小时；以后还要向你学习和帮忙！谢了

liuguansky

http://blog.stevenlevithan.com/archives/algebra-with-regexes
正则求

liuguansky

1. Sub Test()
   
2.     Dim s$, A$(), R As New RegExp, K$()
   
3.     s = Application.InputBox("Ax+By+Cz=D", "请加入A,B,C,D的值,以逗号隔开且为正整数", "14,21,26,488", , , , , 2)
   
4.     If Len(s) = 0 Then Exit Sub
   
5.     A = Split(s, ",")
   
6.     s = VBA.String(CLng(A(3)), "@")
   
7.     With R
   
8.         .Global = True
   
9.         .Pattern = "^(.+?)\1{" & CLng(A(0)) - 1 & "}(.+)\2{" & CLng(A(1)) - 1 & "}(.+)\3{" & CLng(A(2)) - 1 & "}$"
   
10.         If .Test(s) Then
    
11.             K = Split(.Replace(s, "$1 $2 $3"))
    
12.             MsgBox "已求方程的最小正整数解为" & vbCrLf & "A:" & Len(K(0)) & "  ;B:" & Len(K(1)) & "  ;C:" & Len(K(2))
    
13.         Else
    
14.             MsgBox "方程无正整数解"
    
15.         End If
    
16.     End With
    
17. End Sub

复制代码

linshuyan

看看

telexon

CheryBTL 发表于 2013-10-22 07:55
适合二元或三元都行：

DEAR，为何验算又对呢，请帮助看一附件

telexon

telexon 发表于 2013-10-22 21:10
DEAR，为何验算又对呢，请帮助看一附件

DEAR，为何验算又不对呢，请帮助看一附，当参数改6.5，9.5，等就不行了。我查不出原因。8858！

CheryBTL

telexon 发表于 2013-10-22 21:13
DEAR，为何验算又不对呢，请帮助看一附，当参数改6.5，9.5，等就不行了。我查不出原因。8858！

原来定义的参数类型为整数，你输入的是小数，当然会出错
改下变更的类型即可：

1. Dim Totalsum As Integer, X1 As Single, X2 As Single, X3 As Single

复制代码