根据输入范围在 VBA 中输出图形

Question

我正在尝试让我的 VBA 代码根据使用用户定义的函数从多个单元格中选择的输入范围在 Excel 中输出图形。我已将数据作为范围传递给 sub，但最终假设范围是两个数据集，而不是一个具有 x 和 y 值的数据集。数据集从excel中选择到一个单独编写的函数中，然后调用sub。

Sub CreateChart(ByRef r As Range)
Dim cht As Object

  Set cht = ActiveSheet.Shapes.AddChart2
  cht.Chart.SetSourceData Source:=r
  cht.Chart.ChartType = xlXYScatterLines

End Sub

我通过调用子

Call CreateChart(r)

其中 r 是从 excel 中选择的两列数据范围。

Public Function cubic(ByVal r As Range, x As Double, Optional check As Integer = 1) As Double

整体功能代码也在这里

Public Function cubic(ByVal r As Range, x As Double, Optional check As Integer = 1) As Double
    Dim data() As Double
    Dim check1 As Integer
    Dim Smatrix() As Double
    Dim Tmatrix() As Double
    Dim Xmatrix() As Double
    Dim Amatrix() As Double
    Dim Hmatrix() As Double
    Dim m As Integer
    Dim i As Integer
    
    m = r.Rows.Count
    ReDim data(1 To m, 2)
    ReDim Smatrix(1 To m, 1 To m)
    ReDim Tmatrix(1 To m, 4)
    ReDim Xmatrix(1 To m)
    ReDim Amatrix(1 To m - 1, 1 To 4)
    ReDim Hmatrix(1 To m)

    check1 = Test(check)
    
    For i = 1 To m
        data(i, 1) = r(i, 1).Value
        data(i, 2) = r(i, 2).Value
    Next i
    
    Smatrix(1, 1) = 1
    Smatrix(m, m) = 1
    
    For i = 1 To m - 1
        Hmatrix(i) = data(i + 1, 1) - data(i, 1)
    Next i
    
    If check1 = 2 Then
        Smatrix(1, 2) = -1
        Smatrix(m, m - 1) = -1
    End If
    
    For i = 2 To m - 1
        Smatrix(i, i - 1) = Hmatrix(i - 1)
        Smatrix(i, i + 1) = Hmatrix(i)
        Smatrix(i, i) = 2 * (Hmatrix(i - 1) + Hmatrix(i))
    Next i
    
    For i = 2 To m - 1
        Tmatrix(i, 4) = 6 * ((data(i + 1, 2) - data(i, 2)) / Hmatrix(i) - (data(i, 2) - data(i - 1, 2)) / Hmatrix(i - 1))
    Next i
    
    For i = 1 To m
        If i <> 1 Then
            Tmatrix(i, 1) = Smatrix(i, i - 1)
        End If
        
        Tmatrix(i, 2) = Smatrix(i, i)
        
        If i <> m Then
            Tmatrix(i, 3) = Smatrix(i, i + 1)
        End If
    Next i
    
    For i = 2 To m
        Tmatrix(i, 1) = Tmatrix(i, 1) / Tmatrix(i - 1, 2)
        Tmatrix(i, 2) = Tmatrix(i, 2) - Tmatrix(i, 1) * Tmatrix(i - 1, 3)
        Tmatrix(i, 4) = Tmatrix(i, 4) - Tmatrix(i, 1) * Tmatrix(i - 1, 4)
    Next i
    
    Xmatrix(m) = Tmatrix(m, 4) / Tmatrix(m, 2)
    For i = m - 1 To 1 Step -1
        Xmatrix(i) = (Tmatrix(i, 4) - Tmatrix(i, 3) * Xmatrix(i + 1)) / Tmatrix(i, 2)
    Next i
    
    For i = 1 To m - 1
        Amatrix(i, 1) = (Xmatrix(i + 1) - Xmatrix(i)) / 6 * Hmatrix(i)
        Amatrix(i, 2) = Xmatrix(i) / 2
        Amatrix(i, 3) = (data(i + 1, 2) - data(i, 2)) / Hmatrix(i) - Hmatrix(i) * Xmatrix(i) / 2 - Hmatrix(i) * (Xmatrix(i + 1) - Xmatrix(i)) / 6
        Amatrix(i, 4) = data(i, 2)
    Next i
    If x < data(1, 1) Or x > data(m, 1) Then
        Call Check2(x)
        If x < data(1, 1) Then
            cubic = Amatrix(1, 1) * (x - data(1, 1)) ^ 3 + Amatrix(1, 2) * (x - data(1, 1)) ^ 2 + Amatrix(1, 3) * (x - data(1, 1)) + Amatrix(1, 4)
        ElseIf x > data(m, 1) Then
            cubic = Amatrix(m - 1, 1) * (x - data(m - 1, 1)) ^ 3 + Amatrix(m - 1, 2) * (x - data(m - 1, 1)) ^ 2 + Amatrix(m - 1, 3) * (x - data(m - 1, 1)) + Amatrix(m - 1, 4)
        End If
    ElseIf x = data(m, 1) Then
        cubic = data(m, 2)
    Else
        For i = 1 To m - 1
            If data(i, 1) < x And x < data(i + 1, 1) Then
                cubic = Amatrix(i, 1) * (x - data(i, 1)) ^ 3 + Amatrix(i, 2) * (x - data(i, 1)) ^ 2 + Amatrix(i, 3) * (x - data(i, 1)) + Amatrix(i, 4)
            ElseIf x = data(i, 1) Then
                cubic = data(i, 2)
            End If
        Next i
    End If
    Call CreateChart(r)
End Function

以及函数内调用的子程序和函数还没有贴出来

Public Function Test(check As Integer) As Integer
    Dim Response As Integer
    If check = 1 Then
        Response = MsgBox("Boundary Condition 1 selected, is this correct (select No for boundary condition 2)?", vbYesNo, "Boundary Conditions")
        If Response = 6 Then
            Test = 1
        Else
            Test = 2
        End If
    ElseIf check = 2 Then
        Response = MsgBox("Boundary Condition 2 selected, is this correct (select No for boundary condition 1)?", vbYesNo, "Boundary Conditions")
        If Response = 6 Then
            Test = 2
        Else
            Test = 1
        End If
    Else
        Response = MsgBox("Incorrect Boundary Condition, select Yes for condition 1 and No for condition 2", vbYesNo, "Boundary Conditions")
        If Response = 6 Then
            Test = 1
        Else
            Test = 2
        End If
    End If
End Function

Public Sub Check2(x)
    MsgBox ("Value given is outside data range, answer may not be correct, extrapolating from calculated polynomial")
End Sub

Answer 1

试试

Sub CreateChart(ByRef r As Range)
    Dim cht As Object
    Set cht = ActiveSheet.Shapes.AddChart2(XlChartType:=xlXYScatterSmooth)
    cht.Chart.SetSourceData Source:=r
End Sub