EXCEL VBA¨D¤@¤¸¤G¦¸¤èµ{¦¡ (¤£¥Î¤½¦¡¸Ñ)(2) EXCE, VBA

´Ë³¥

¦]¬°¤p¾Ç¥Í¤£¯à¦AEXCELµ{¦¡°ÏªO¦^´_ ­º¥ý·PÁÂAndy2483¦^À³ ¦ý§Ú¬Ýµ{¦¡½X¸Ì­±¤]¦³¤½¦¡¦b¸Ì­±  ¥i¯à¬O§Ú´y­z¤£²M·¡ §Ú­«·s´y­z¤@¦¸
¥Îexcel vba ¨D¸Ñ¤@¤¸¤G¦¸¤èµ{¦¡X²+2X-4=0 ¤£¯à¥Î±a¤J¤½¦¡ªº¤è¦¡(¦]¬°¦pªG§ó°ª¦¸¤]³\´N¨S¦³¤½¦¡¥i¥H±a¤J)¡Aªþ¥ó¦³¸Ô²Ó»¡©ú

µ²½×
1.x1¡Bx2¥N¤J¦h¤Ö¡A§P©w¥¿½T¤è¦V¡A¿ù»~´N°±¤î
2.¤W­z§ä¥X¥¿½T¤è¦V¡A¹Gªñ¸Ñ¡A³Ì²×§ä¥X¸Ñµª
·Qª¾¹D¦p¦ó³]©wµ{¦¡½X¥H¤Î¸Ô²Ó

¤U¸ü (24.14 KB)
»¡©ú

2021-10-20 11:00

Andy2483

¦^´_ 1# ´Ë³¥


°Ñ¦Ò
Option Explicit
Sub TEST()
Dim X, Y, a, b, c, n, U1, U2, u, v, S, S0, S1, Y0, Y1, X1, X2, P, J
J = 1: Y = a * X ^ n + b * X + c: a = 1: b = 2: c = -4: n = 2
If n = 2 Then
   If (4 * a * c - b ^ 2) / 4 * a = 0 Then
      MsgBox "°ß¤@¸Ñ X= " & (-b) / (2 * a): Exit Sub
      ElseIf ((4 * a * c - b ^ 2) / 4 * a > 0 And a > 0) Or ((4 * a * c - b ^ 2) / 4 * a < 0 And a < 0) Then
         MsgBox " X µL¸Ñ!": Exit Sub
   End If
   If b = 0 And c < 0 Then X1 = (-c / a) ^ 0.5: X2 = -(-c / a) ^ 0.5
End If
888: S0 = -100 * J: S1 = 100 * J: S = J: P = 1
999
For X = S0 To S1 Step S
   Y0 = a * X ^ n + b * X + c
   Y1 = (a * (X + S)) ^ n + (b * (X + S)) + c
   P = Y0 * Y1
   If (S < 10 ^ -13 And J = 1) Or (S > -(10 ^ -13) And J = -1) Then P = 0
   If P = 0 Then
      If c = 0 And J = 1 Then X1 = X
      If c = 0 And J = -1 Then X2 = X
      If J = -1 Then: MsgBox "X1= " & X1 & vbLf & vbLf & "X2= " & X2: Exit Sub
      J = -1: GoTo 888
      ElseIf P < 0 Then
         S0 = X: S1 = S0 + S: S = S / 10  '
         If J = 1 Then
            MsgBox "X1 ¤¶©ó " & S0 & " ~ " & S1
            X1 = S1
            Else
               MsgBox "X2 ¤¶©ó " & S0 & " ~ " & S1
               X2 = S1
         End If
         GoTo 999
   End If
Next
End Sub
End Sub

´Ë³¥

¦^´_ 2# Andy2483

«e½ú±z¦n  ¥i¥Hµy·L²³æ»¡©ú¤@¤U¨C¶µ¥Nªíªº·N¸q¶Ü
³o¦ê¥H¤U¦n¹³¬O¤½¦¡ ³]©w³o¦êªº¥Î·N¬O¤°»ò (4 * a * c - b ^ 2) / 4 * a = 0  (¦pªG¤£¯à¥Î¤½¦¡¸Ñ¬O§_¥i¥H¤£³]©w¦¹¶µ)
If n = 2 Then  
   If (4 * a * c - b ^ 2) / 4 * a = 0 Then
      MsgBox "°ß¤@¸Ñ X= " & (-b) / (2 * a): Exit Sub
      ElseIf ((4 * a * c - b ^ 2) / 4 * a > 0 And a > 0) Or ((4 * a * c - b ^ 2) / 4 * a < 0 And a < 0) Then
         MsgBox " X µL¸Ñ!": Exit Sub
½Ð«e½úµy·L»¡©ú¤@¤U
888 ©M999©M S0¤ÎS0 =-100*J©MS1©M S1 =100*J ¬O¤°»ò
ÁÙ¦³¥H¤Uªº³]©w»¡©ú ·Q¤F¸Ñ¸Ô²Ó
End If
888: S0 = -100 * J: S1 = 100 * J: S = J: P = 1  
999
For X = S0 To S1 Step S
   Y0 = a * X ^ n + b * X + c
   Y1 = (a * (X + S)) ^ n + (b * (X + S)) + c
   P = Y0 * Y1
   If (S < 10 ^ -13 And J = 1) Or (S > -(10 ^ -13) And J = -1) Then P = 0
   If P = 0 Then
      If c = 0 And J = 1 Then X1 = X
      If c = 0 And J = -1 Then X2 = X
      If J = -1 Then: MsgBox "X1= " & X1 & vbLf & vbLf & "X2= " & X2: Exit Sub
      J = -1: GoTo 888
      ElseIf P < 0 Then
         S0 = X: S1 = S0 + S: S = S / 10  '
         If J = 1 Then
            MsgBox "X1 ¤¶©ó " & S0 & " ~ " & S1
            X1 = S1
            Else
               MsgBox "X2 ¤¶©ó " & S0 & " ~ " & S1
               X2 = S1
         End If
         GoTo 999
   End If
Next
End Sub
¤W­zµ{¦¡¶]¥X¨Ó
X1=1.2360679774997¡AX2=-3.2360679774997
µª®×«á­±¦n¹³ÁÙ¤Ö¤@¶µ¼Æ¦r
X1=1.23606797749979¡AX2=-3.23606797749979
µ{¦¡À³¸Ó­n«ç»ò§ï
·PÁ«e½ú

Andy2483

¦^´_ 1# ´Ë³¥


Option Explicit
Sub ¤@¤¸¤G¦¸¤èµ{¦¡()
'X ^ 2 + 2 * X - 4 = 0 ¦³¨â¸Ñ
Dim X, S, S0, S1, Y0, Y1, X1, X2, P
S0 = -1000
S1 = 1000
S = 1
'¡ô³]©wÅܼƪì­È
888
'¡õ¶}©l°j°é(-1000 ¨ì 1000 ¶¡¹j1)
For X = S0 To S1 Step S
   Y0 = X ^ 2 + 2 * X - 4
   Y1 = (X + S) ^ 2 + 2 * (X + S) - 4
   P = Y0 * Y1
   '¡õ¹B¥Î¤G¦¸¨ç¼Æ¦bY­È=0«eªº­t¼Æ»PY­È=0«áªº¥¿¼Æ­¼¿n¬O­t¼Æ
   If P < 0 Then
      S0 = X '­«·sµ¹S0³]©w­È
      S1 = S0 + S '­«·sµ¹S1³]©w­È
      S = S / 10  '­«·sµ¹S³]©w­È
      MsgBox "X1 ¤¶©ó " & S0 & " ~ " & S1
      X1 = S1
      GoTo 888 'µ²§ô°j°é,¸õ¨ì 888 ¦ì¸mÄ~Äò°õ¦æ
   End If
Next
''''''''''''''''''''''''''''''''''''''''''''''''
S0 = 1000
S1 = -1000
S = -1
'¡ô­«³]Åܼƪì­È
999
'¡õ¶}©l°j°é(1000 ¨ì -1000 ¶¡¹j-1)
For X = S0 To S1 Step S
   Y0 = X ^ 2 + 2 * X - 4
   Y1 = (X + S) ^ 2 + 2 * (X + S) - 4
   P = Y0 * Y1
   If P < 0 Then
      S0 = X
      S1 = S0 + S
      S = S / 10
      MsgBox "X2 ¤¶©ó " & S0 & " ~ " & S1
      X2 = S1
      GoTo 999
   End If
Next
MsgBox "X1= " & X1 & vbLf & vbLf & "X2= " & X2
End Sub

Sub ¤@¤¸¤G¦¸¤èµ{¦¡¾ã¼Æ¸Ñ1()
Dim X
For X = -1000 To 1000 Step 1
   If X ^ 2 - 4 = 0 Then MsgBox "X = " & X
Next
End Sub

Sub ¤@¤¸¤G¦¸¤èµ{¦¡¾ã¼Æ¸Ñ2()
'1©`¦Ì¡]nm¡^= 10 ®J¡]A¡^= 10^-9m
'¹q¸£­nRUN 2000*10^9¦¸§PÂ_,EXCEL·|·Pı·í±¼
Dim X
For X = -1000 To 1000 Step 10 ^ -9
   If X ^ 2 - 4 = 0 Then MsgBox "X = " & X
Next
End Sub

ML089

'¤@¤¸¤G¦¸¤èµ{¦¡:X2+2X-4=0 ,
'¥Î¤½¦¡¸Ñx=(-b¡Ó¡Ôb^2-4ac)/2aªº¤è¦¡¡A
'¥i¥H¨D¥XX1=1.23606797749979 X2=-3.2360679774997

'°O±o30¦~«eªì¾ÇFortran»y¨¥®É¡A½m²ß¹L ¤û¹yXX¸Ñªk¡A¬ù3~5¨B´N¥i¥H¨D¥Xªñ¦ü¸Ñ¡Aºô¸ô¤W§ä¤@¤U«Ü¦h¡C
'²{¦b¹q¸£­pºâ¯à¤O¤Ó±j¤F¡A¥i¥H«Ü¼É¤Oª½±µ¥Ñ -10000 ­pºâ¨ì 10000¡A¥Hf(x)¡Bf(x+s)¨â¼Æ­È»~®t¦b¤p¼Æ12¦ì¼Æ®É§@¬°ªñ¦ü¸Ñ¡C
'´`Àô¦¸¼Æ¬ù20000½d³ò+500~800¦¬ÀĨBÆJ´N¥i¥H¨D±o
x1        x2        f(x1)
ªñ¦ü¸Ñ¡G-3.2360679774998 ,  »~®t­È4.17443857259059E-14               
ªñ¦ü¸Ñ¡G1.23606797749978 , »~®t­È3.73034936274053E-14               
´`Àô¦¸¼Æ¡G20612               
­pºâ®É¶¡¡G0.156               


Function f(x)
    f = x ^ 2 + 2 * x - 4
End Function
Sub ¤@¤¸¤èµ{¦¡¼É¤O¸Ñªk_ML089()
    Dim r, c1, c2, n, x, x2, s, ss, ct, tm
    tm = Timer
    '[A:C].Clear
    Sheets.Add.Name = Format(Now(), "dd_hhmmss")
    x = -10000: x2 = 10000 '¬d¸ß°Ï¶¡
    s = 1: ss = 100        'Step ªì©l­È¤Î²Ó¤À°£¼Æ
   
    r = 3: c1 = 1: c2 = 2 'cells ¦ì¸m
    Cells(r, c1).Resize(, 3) = Array("x1", "x2", "f(x1)")
    While x <= x2
        ct = ct + 1
        If Application.Median(f(x), 0, f(x + s)) = 0 Then
            r = r + 1
            Cells(r, c1).Resize(, 3) = Array(x, x + s, f(x)) 'Debug ¥Î
            If Round(f(x), 12) = 0 Then
                r = r + 1
                Cells(r, c1) = "ªñ¦ü¸Ñ¡G" & x & " , " & f(x)
                x = x + s
                s = 1
            Else
                s = s / ss
            End If
        Else
            x = x + s
        End If
    Wend
    Cells(r + 1, c1) = "´`Àô¦¸¼Æ¡G" & ct
    Cells(r + 2, c1) = "­pºâ®É¶¡¡G" & Format(Timer - tm, "0.000")
End Sub

ML089

¦b¸É¥R¤@¤U¼Ó¤Wªºµ{¦¡·§©À
¢¯¢°¡@¥Ñ -10000 ¦Ü 10000 STEP s
¢¯¢±¡@¡@·í f(x)¡Bf(x + s)ªº­È¦b 0 ªº¥ª¥k¤§®É
¢¯¢²¡@¡@¡@Àˬd¤p¼Æ12¦ì¼Æ¥H¤º¬O§_¬° 0¡A
¡@¡@¡@¡@¡@¡@¬O¡G´N¬Oªñ¦ü¸Ñ¤§¤@¡A­«·s³] s=1«á¦A­«·s¢¯¢±¬d¸ß¤U¤@­Óªñ¦ü¸Ñ
¡@¡@¡@¡@¡@¡@§_¡G³] s = s/100¡A¦A­«·s¢¯¢±¨BÆJ

x1        x2        f(x1)
-4        -3        4¡@(²Ä¢°¦¸¢¯¦b¢î(-4)»Pf(-3)¤§¶¡¡As=1)
-3.24        -3.23        0.0176¡@(²Ä2¦¸¢¯¦b¢î(-3.24)»Pf(-3.23)¤§¶¡¡As=1/100)
-3.2361        -3.236        0.00014321¡@(²Ä3¦¸¢¯¦b¢î(-3.2361)»Pf(-3.231)¤§¶¡¡As=1/10000)
-3.236068        -3.236067        1.00624E-07
-3.23606798        -3.23606797        1.11813E-08
-3.236067978        -3.236067977        9.56568E-13
-3.236067978        -3.236067977        9.56568E-13
-3.236067977        -3.236067977        4.17444E-14
ªñ¦ü¸Ñ¡G-3.2360679774998 , 4.17443857259059E-14               
0.763932023        1.763932023        -1.88854382
1.233932023        1.243932023        -0.009547719
1.236032023        1.236132023        -0.000160794
1.236067023        1.236068023        -4.27089E-06
1.236067973        1.236067983        -2.23588E-08
1.236067977        1.236067978        -4.45365E-10
1.236067977        1.236067978        -2.5846E-12
1.236067977        1.236067977        -3.73035E-14
ªñ¦ü¸Ñ¡G1.23606797749978 , -3.73034936274053E-14               
´`Àô¦¸¼Æ¡G20612               
­pºâ®É¶¡¡G0.168

Andy2483

¦^´_ 6# ML089


    «e½ú¼F®`!
«e½ú¬O¸ê°T¬ì¨t¶Ü?
§Ú¬O¾÷±ñ¬ì¨t,¸£µ¬¤ñ¸û¾q¶w,¤]¦Ñ¤F¤~¾ÇVBA!
¹ï«e½ú­Ì«D±`¨ØªA!
§Ú­ÌªºMIS ¸Ó¤W³o½×¾Â¨Ó¬ã¨s¬ã¨s!
¸Ó¥ÎEXCEL·íERPªº«e¥x!
ÁÂÁ¤À¨É!

ML089

¦^´_ 7# Andy2483

¤g¤ì¨t­pºâ¾÷µ{¦¡¤~·|±ÐFortran
VBA¤]¬O¦b½×¾Â¬Ý§A¤Î¨ä¥L°ª¤âªºµªÃDºCºC¾Ç²ß¨Óªº¡A·PÁ§Aªº¿ãÅDµªÃD¾Ç²ß¤£¤Ö¡C
­«ÂI¬O¦b¬¡¤Æ¦Û¤vªº¸£µ¬ÁקK¦Ñ¦~·ö§b¯g(¤]¤£ª¾¦³¨S¦³®Ä?)
¥­±`¤é³£¦^µª¨ç¼Æ¤½¦¡¡A°²¤é¦³ªÅ¤~¯à½m²ß¤@¨ÇVBA¡A²¦³ºVBA¤]¤£¬O¤Ó¼ô¡C

Andy2483

¦^´_ 8# ML089


1.30¦~«e¾÷±ñ¨t¬O¾ÇC»y¨¥,¨S»{¯u¾Ç!¤@¤ä¯ó¤@ÂIÅS! ©¹3D Catia Æp¬ã¨ì¥æ´Î,ÂàºÞ²z¤~µo²{ºÞ²z¤£¬O½|½|¤H´N¦n,¤@¤ÀÃÒ¾Ú»¡¤@¤À¸Ü¤~¯àªA²³!
°fµÛ¾ÇVBA,±q¿ý»s¥¨¶°¶}©l¾Ç,¤@¸ô¨SÄvª§ªÌ¤S«ÜÂû±C¨ì³BÀ°¦P¨Æ¼g³ô¥Îªº¥¨¶°! ¬Ý¨ì¥H«eªº ¶Q¤H¦b¦¹½×¾Â!ªY³ß´N¶i¨Ó¤F!

2.¦Ñ¦~·ö§b¯gª¬¦³ÂI¸ñ¶H¤F,µø¤O¤]°h¤Æ¤F!±`°Ê¸£.±`¬q½m¨­Åé,«O«ù°·±d¤~¬O³Ì­«­nªº!¦@«j

3.¹ï¤G¦¸¦±½u¦³¿³½ì,´N½Æ²ß¤F y=ax2+bx+c ,­è¦nª©¥D­n¦¬Àıo¨ì¸Ñµªªº¤èªk,¤]¬O¤@ªÑ¸£¥Î¤@©Û¥b¦¡¦^µª!
·j´M¤FMedian§ä¨ì³oºô­¶: https://docs.microsoft.com/zh-tw/office/vba/api/excel.worksheetfunction.median
©ß¿j¤Þ¥É¾Ç¨ì¤F«Ü¦h! ÁÂÁÂ! ¤]ÁÂÁ½׾ªº¦h¤¸©Ê!

4.«á½ú¥Î¦h¦¸¦±½uªº·§©À¬ã¨s¤F¤@¤¸¥|¦¸¤èµ{¦¡ªº¹ê¼Æ¸Ñªk¤]©ñ¤W¨Ó! °O¿ý¤U¨Ó! ¦h¦~¥H«á¦A¦^ÀY¬Ý¦¹©«! À³¸Ó¬O¤­¨ýÂø³¯!
½Ð¦³¿³½ìªº«e½ú­Ì¤À¨É.«ü¾É!ÁÂÁÂ!

Option Explicit
Sub ¤@¤¸¤@¤G¤T¥|¦¸¤èµ{¦¡_¹ê¼Æ¸Ñ()
Dim InB$, Q$, i&, x#, x1#, a#, a1#, a2#, b#, c#, s#, S0#, S1#, S2#, Y0#, Y1#
Dim P#, J$, T&, d&, Arr, st#, S3#, K$, K1$, K2$, Kb$, Kc$
InB = UCase(InputBox("½Ð¿é¤J¤èµ{¦¡ ¨Ò:  X4-6X3+X2+2X+24=0", "½Ð¿é¤J", "2X4-4X3-3X2+7X-2=0"))
If (InB Like "*0" = False And InB Like "*#") Or InB Like "*X" Then InB = InB & "=0"
Q = InB: InB = Replace(InB, " ", "")
If InB Like "*X*=0" = False Or InB Like "*,*" Then T = -1: GoTo 777
If InB Like "X*" Then InB = "1" & InB
If InB Like "-X*" Then InB = "-1" & InB
InB = Replace(Replace(InB, "+X", "+1X"), "-X", "-1X")
InB = Replace(Replace(Replace(Replace(InB, "X4=", "X4+0="), _
      "X3=", "X3+0="), "X2=", "X2+0="), "X1=", "X1+0=")
InB = Replace(Replace(Replace(Replace(InB, "+", ",+"), "-", ",-"), "=0", ",=,"), "X", ",X")
Arr = Split(InB, ",")
If InStr(",X4,X3,X2,X,", "," & Arr(1) & ",") = 0 Then T = -3: GoTo 777
For i = 0 To UBound(Arr)
   If Arr(i) = "X4" Then a2 = Arr(i - 1)
   If Arr(i) = "X3" Then a1 = Arr(i - 1)
   If Arr(i) = "X2" Then a = Arr(i - 1)
   If Arr(i) = "X" Then b = Arr(i - 1)
   If Arr(i) = "=" Then c = Arr(i - 1)
Next
K = a: K1 = a1: K2 = a2: Kb = b: Kc = c:
If K & K1 & K2 & Kb & Kc Like "*0.*" Then T = -4: GoTo 777
T = 0: d = 26: S0 = -10001: S1 = 10001: S2 = S1: s = 0.5: st = s: P = 1
999
For x = S0 To S1 Step s
   DoEvents
   If s = st Then S3 = x
   Y0 = a2 * x ^ 4 + a1 * x ^ 3 + a * x ^ 2 + b * x + c: x1 = x + s
   Y1 = a2 * x1 ^ 4 + a1 * x1 ^ 3 + a * x1 ^ 2 + b * x1 + c
   If Y0 = 0 Then
      J = J & vbLf & "¹ê¼Æ¸ÑX = " & x: S0 = S3 + s: S1 = S2: GoTo 999
   End If
   If Y1 = Y0 Then S0 = x + st: S1 = S2: GoTo 999
   P = Y0 * Y1
   If Int(Abs(P * 10 ^ d)) = 0 Then
      T = T + 1
      If s <> st Then J = J & vbLf & "¹ê¼Æ¸ÑX = " & x1
      s = st: S0 = S3 + s: S1 = S2: GoTo 999
   End If
   If Int(Abs(s * 10 ^ d)) = 0 Then P = 0
   If P < 0 Then
      S0 = x: S1 = S0 + s: s = s / 10: GoTo 999
      ElseIf P > Abs(a2) + Abs(a1) + Abs(a) + Abs(b) + Abs(c) Then
         S0 = x + st: S1 = S2: GoTo 999
   End If
Next
777
If T > 0 Then
   MsgBox Q & vbLf & J
   ElseIf T = 0 Then
      MsgBox Q & vbLf & vbLf & " X µL¹ê¼Æ¸Ñ!"
   Else
      MsgBox Q & vbLf & vbLf & " µLªk°õ¦æ!"
End If
End Sub

ML089

¦^´_ 9# Andy2483

¥ÑUSER¿é¤J¤èµ{¦¡¡A¨ã¦³¹ê¥Î©Ê»ù­È¼g±o«Ü¦n¡Aµ{¦¡­pºâ³t«×«Ü§Ö§óºë·Ç¡AÆg¡C