ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¦³关Excel¨D·L积¤Àªº问题

[µo°Ý] ¦³关Excel¨D·L积¤Àªº问题

¤@维积¤À¥Ø«e¤w经¦³ExcelHomeªºchenjun¤j¤û写过¤@个©«¤l
¥L¥»¤H¨Ï¥Î§»ªí¨ç数Evaluate¨î§@¤F两个®×¨Ò
将¤§写¦¨VBA¦Û©w义¨ç数¡A¬O§Úªñ´Á·Q°µªº¨Æ

关¤_¤G维¥H¤Î¦h维积¤À¡A¤£ª¾¹D¦³­þ¦ì¤j¤û¯à°µ¥X®×¨Ò来¡A¨Ñ¤j®a参¦Ò¡C¡C¡C¡C

±è§Î¤½¦¡©M¨¯´¶¥Í¤½¦¡.zip (42.75 KB)

¤@维积¤À

¯x§Î¤½¦¡ªk.zip (4.82 KB)

¤@维积¤À

¦V°ª¤â学习

¥e楼¡A将来汇总©ÎÖß贴¤@维积¤À¦Û©w义¨ç数
'¨¯´¶¥Í积¤Àªk
'FUNC_STR_NAME为¨ç数¦W
  1. '================================
  2. ' ¨¯´¶´Ë积¤Àªk
  3. ' Simpson_Integral_Func
  4. ' http://www.cnhup.com
  5. '================================
  6. Function Simpson_Integral_Func( _
  7.    ByRef Lower_Bound As Double, _
  8.    ByRef Upper_Bound As Double, _
  9.    Optional ByRef epsilon As Double = 2 ^ -52)

  10.   Dim i As Long
  11.   Dim J As Long

  12.   Dim X_VAL As Double

  13.   Dim S1_VAL As Double
  14.   Dim S2_VAL As Double
  15.   Dim S3_VAL As Double
  16.   Dim S4_VAL As Double

  17.   Dim Delta_VAL As Double
  18.   Dim Result_VAL As Double

  19.   On Error GoTo ERROR_HANDEL_LABEL

  20.   S3_VAL = 1#
  21.   Delta_VAL = Upper_Bound - Lower_Bound
  22.   S1_VAL = FUNC_STR_NAME(Lower_Bound) + _
  23.      FUNC_STR_NAME(Upper_Bound)

  24.   i = 0
  25.   Do
  26.     S4_VAL = S3_VAL
  27.     Delta_VAL = Delta_VAL / 2#
  28.     S2_VAL = 0#
  29.     X_VAL = Lower_Bound + Delta_VAL
  30.     J = 0
  31.     Do
  32.     S2_VAL = S2_VAL + 2# * FUNC_STR_NAME(X_VAL)
  33.     X_VAL = X_VAL + 2# * Delta_VAL
  34.     J = J + 1
  35.     Loop Until Not X_VAL < Upper_Bound
  36.     S1_VAL = S1_VAL + S2_VAL
  37.     S3_VAL = (S1_VAL + S2_VAL) * Delta_VAL / 3#
  38.     X_VAL = Abs(S4_VAL - S3_VAL) / 15#
  39.     i = i + 1
  40.   Loop Until Not X_VAL > epsilon
  41.   Result_VAL = S3_VAL

  42.   Simpson_Integral_Func = Result_VAL

  43.   Exit Function
  44. ERROR_HANDEL_LABEL:
  45.   Simpson_Integral_Func = Err.Number
  46. End Function
½Æ»s¥N½X
¦V°ª¤â学习

TOP

¯x§Î¤½¦¡¡A«Ý­×§ï为¦Û©w义¨ç数
  1. Sub ¨D©w积¤À()
  2.     On Error Resume Next
  3.     Dim n1 As Integer, n As Integer, i As Integer
  4.     Dim s As String
  5.     Dim C1 As Double, C2 As Double, C3 As Double
  6.     If ActiveSheet.UsedRange.Rows.Count < 2 Then
  7.         Cells(1, 1) = "积¤À¦¡"
  8.         Cells(1, 2) = "¤U­­"
  9.         Cells(1, 3) = "¤W­­"
  10.         Cells(1, 4) = "计ºâ结ªG"
  11.         s = MsgBox("请从²Ä¤G¦æ开©l¡A¨C¤@¦æ¥i计ºâ¤@个积¤À¡A" & Chr(13) & "²Ä¤@¦C输¤J积¤À¦¡¡A积¤À变¶q¥u¯à¥ÎX¡A" & Chr(13) & "¦}¥B­n«ö·ÓExcel¤½¦¡ªº­n¨D输¤J", , "´£¥Ü«H®§")
  12.     End If
  13.     n = ActiveSheet.UsedRange.Rows.Count
  14.     Columns(5).Hidden = True
  15.     For n1 = 2 To ActiveSheet.UsedRange.Rows.Count
  16.         s = Cells(n1, 1)
  17.         C1 = Cells(n1, 2) '积¤À¤U­­
  18.         C2 = Cells(n1, 3) '积¤À¤W­­
  19.         If s = "" Or C1 = 0 And C2 = 0 Then GoTo w1
  20.         s = UCase(s) '¤p写变¤j写
  21.         n = InStr(s, "X")
  22.         Do While n > 0
  23.             s = Left(s, n) & " " & Mid(s, n + 1)
  24.             Mid(s, n) = "e2"
  25.             n = InStr(s, "X")
  26.         Loop
  27.         Cells(n1, 4) = "=" & s
  28.         n = 2000 '¤p¤_32767,N­È¶V¤j,结ªG¶VºëÚÌ
  29.         C3 = (C2 - C1) / n
  30.         Cells(n1, 5) = C1
  31.         C2 = Cells(n1, 4) / 2
  32.         For i = 1 To n
  33.             Cells(n1, 5) = i * C3 + C1
  34.             C2 = C2 + Cells(n1, 4)
  35.         Next i
  36.         Cells(n1, 4) = (C2 - Cells(n1, 4) / 2) * C3
  37. w1:     Beep
  38.     Next n1
  39. End Sub
½Æ»s¥N½X
¦V°ª¤â学习

TOP

¥»©«³Ì«á¥Ñ loquat ©ó 2013-2-22 17:37 ½s¿è

¯x§Î积¤À
  1. Public Function ¯x§Î积¤À(r As String, a As Double, b As Double, n As Integer) As Double
  2. Dim dx As Double
  3. dx = (b - a) / n
  4. For i = 1 To n
  5.     ¯x§Î积¤À = ¯x§Î积¤À + Evaluate(Replace(r.Value, "x", (a + dx * (i - 1)))) * dx
  6. Next i
  7. End Function
½Æ»s¥N½X
±è§Î积¤À
  1. Public Function ±è§Î积¤À(r As String, a As Single, b As Single, n As Integer) As Double
  2. Dim dx As Double
  3. dx = (b - a) / n
  4. For i = 1 To n
  5.     ±è§Î积¤À = ±è§Î积¤À + Evaluate(Replace(r.Value, "x", (a + dx * (i - 1 / 2)))) * dx
  6. Next i
  7. End Function
½Æ»s¥N½X
¥H¤W¨ç数¡Ar为¨ç数关¨t¦¡¡Aa为积¤À¤U­­¡Ab为积¤À¤W­­¡An为¤À³Î¦¸数¡An¤£±o¤j¤_32766
¦V°ª¤â学习

TOP

4#ªº
  1. r.Value
½Æ»s¥N½X
»Ý­n§ï为
  1. r
½Æ»s¥N½X
¦V°ª¤â学习

TOP

  1. Public Function Î`¤Æ±è§Î积¤À(r As String, a As Single, b As Single, n As Integer) As Double
  2. Dim dx As Double, i As Integer
  3. dx = (b - a) / n
  4. Î`¤Æ±è§Î积¤À = (Evaluate(Replace(r, "x", a)) + Evaluate(Replace(r, "x", b))) / 2
  5. For i = 1 To n - 1
  6.     Î`¤Æ±è§Î积¤À = Î`¤Æ±è§Î积¤À + Evaluate(Replace(r, "x", (a + i * dx)))
  7. Next i
  8. Î`¤Æ±è§Î积¤À = Î`¤Æ±è§Î积¤À * dx
  9. End Function
½Æ»s¥N½X
  1. Public Function ¨¯´¶¥Í积¤À(r As String, a As Single, b As Single, n As Integer) As Double
  2. Dim dx As Double, i As Integer, m As Integer
  3. m = 2 * n
  4. dx = (b - a) / m
  5. ¨¯´¶¥Í积¤À = Evaluate(Replace(r, "x", a)) + Evaluate(Replace(r, "x", b))
  6. For i = 2 To m Step 2
  7.     ¨¯´¶¥Í积¤À = ¨¯´¶¥Í积¤À + Evaluate(Replace(r, "x", (a + dx * (i - 1)))) + 2 * Evaluate(Replace(r, "x", (a + dx * i)))
  8. Next i
  9. ¨¯´¶¥Í积¤À = ¨¯´¶¥Í积¤À * dx * 2 / 3
  10. End Function
½Æ»s¥N½X
  1. Public Function Î`¤Æ¨¯´¶¥Í积¤À(r As String, a As Single, b As Single, n As Integer) As Double
  2. Dim dx As Double, i As Integer, m As Integer
  3. m = 2 * n
  4. dx = (b - a) / m
  5. Î`¤Æ¨¯´¶¥Í积¤À = Evaluate(Replace(r, "x", a)) + Evaluate(Replace(r, "x", b))
  6. For i = 2 To m Step 2
  7.     Î`¤Æ¨¯´¶¥Í积¤À = Î`¤Æ¨¯´¶¥Í积¤À + 4 * Evaluate(Replace(r, "x", (a + dx * (i - 1)))) + 2 * Evaluate(Replace(r, "x", (a + dx * i)))
  8. Next i
  9. Î`¤Æ¨¯´¶¥Í积¤À = (Î`¤Æ¨¯´¶¥Í积¤À - 2 * Evaluate(Replace(r, "x", (a + dx * m)))) * dx / 3
  10. End Function
½Æ»s¥N½X
¨ä¤¤Î`¤Æ¨¯´¶¥Í积¤À¤½¦¡®Ä²v³Ì°ª¡C
还¦b¬ã¨s¨ä¥L§ó·d¯ºªº计ºâ¤èªk¡C¡C
¦V°ª¤â学习

TOP

        ÀR«ä¦Û¦b : ¡i®É¤é²öªÅ¹L¡j¤@­Ó¤H¦b¥@¶¡°µ¤F¦h¤Ö¨Æ¡A´Nµ¥©ó¹Ø©R¦³¦hªø¡C¦]¦¹¥²¶·»P®É¶¡Ävª§¡A¤Á²ö¨Ï®É¤éªÅ¹L¡C
ªð¦^¦Cªí ¤W¤@¥DÃD