关于excel的宏。有没有有人会用宏做微积分?代码是什么??
2个回答
展开全部
http://zhidao.baidu.com/question/425395358.html
excel中vba数值积分代码
Sub 求定积分()
On Error Resume Next
Dim N1 As Integer, N As Integer, i As Integer
Dim S As String
Dim C1 As Double, C2 As Double, C3 As Double
If ActiveSheet.UsedRange.Rows.Count < 2 Then
Cells(1, 1) = "积分式"
Cells(1, 2) = "下限"
Cells(1, 3) = "上限"
Cells(1, 4) = "计算结果"
S = MsgBox("请从第二行开始,每一行可计算一个积分" & Chr(13) & "第一列输入积分式,积分变量只能用X," & Chr(13) & "并且要按照Excel公式的标准输入", , "提示信息")
End If
N = ActiveSheet.UsedRange.Rows.Count
Columns(5).Hidden = True
For N1 = 2 To ActiveSheet.UsedRange.Rows.Count
S = Cells(N1, 1)
C1 = Cells(N1, 2) '积分下限
C2 = Cells(N1, 3) '积分上限
If S = "" Or C1 = 0 And C2 = 0 Then GoTo w1
S = UCase(S)
N = InStr(S, "X")
Do While N > 0
S = Left(S, N) & " " & Mid(S, N + 1)
Mid(S, N) = "e2"
N = InStr(S, "X")
Loop
Cells(N1, 4) = "=" & S
N = 2000 '小于32767,N值越大,结果越精确
C3 = (C2 - C1) / N
Cells(N1, 5) = C1
C2 = Cells(N1, 4) / 2
For i = 1 To N
Cells(N1, 5) = i * C3 + C1
C2 = C2 + Cells(N1, 4)
Next i
Cells(N1, 4) = (C2 - Cells(N1, 4) / 2) * C3
w1: Beep
Next N1
End Sub
excel中vba数值积分代码
Sub 求定积分()
On Error Resume Next
Dim N1 As Integer, N As Integer, i As Integer
Dim S As String
Dim C1 As Double, C2 As Double, C3 As Double
If ActiveSheet.UsedRange.Rows.Count < 2 Then
Cells(1, 1) = "积分式"
Cells(1, 2) = "下限"
Cells(1, 3) = "上限"
Cells(1, 4) = "计算结果"
S = MsgBox("请从第二行开始,每一行可计算一个积分" & Chr(13) & "第一列输入积分式,积分变量只能用X," & Chr(13) & "并且要按照Excel公式的标准输入", , "提示信息")
End If
N = ActiveSheet.UsedRange.Rows.Count
Columns(5).Hidden = True
For N1 = 2 To ActiveSheet.UsedRange.Rows.Count
S = Cells(N1, 1)
C1 = Cells(N1, 2) '积分下限
C2 = Cells(N1, 3) '积分上限
If S = "" Or C1 = 0 And C2 = 0 Then GoTo w1
S = UCase(S)
N = InStr(S, "X")
Do While N > 0
S = Left(S, N) & " " & Mid(S, N + 1)
Mid(S, N) = "e2"
N = InStr(S, "X")
Loop
Cells(N1, 4) = "=" & S
N = 2000 '小于32767,N值越大,结果越精确
C3 = (C2 - C1) / N
Cells(N1, 5) = C1
C2 = Cells(N1, 4) / 2
For i = 1 To N
Cells(N1, 5) = i * C3 + C1
C2 = C2 + Cells(N1, 4)
Next i
Cells(N1, 4) = (C2 - Cells(N1, 4) / 2) * C3
w1: Beep
Next N1
End Sub
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询
广告 您可能关注的内容 |