求excel中两个曲线交点

2024-11-08 06:50:45
推荐回答(1个)
回答1:

如图,CommandButton1的程序如下:

Private Sub CommandButton1_Click()
Dim i As Integer, j As Integer
[e1].Formula = "=MDETERM(F1:H3)"
[f7:g7].ClearContents
For j = 2 To Range("C65536").End(xlUp).Row - 1
  For i = 2 To Range("A65536").End(xlUp).Row - 1
    [f1] = Cells(j, "c")
    [g1] = Cells(j, "d")
    [h1] = 1
    [f2] = Cells(j + 1, "c")
    [g2] = Cells(j + 1, "d")
    [h2] = 1
    [f3] = Cells(i, "a")
    [g3] = Cells(i, "b")
    [h3] = 1
    [i1] = [e1]
    [f3] = Cells(i + 1, "a")
    [g3] = Cells(i + 1, "b")
    [h3] = 1
    [i2] = [e1]
    [f1] = Cells(i, "a")
    [g1] = Cells(i, "b")
    [h1] = 1
    [f2] = Cells(i + 1, "a")
    [g2] = Cells(i + 1, "b")
    [h2] = 1
    [f3] = Cells(j, "c")
    [g3] = Cells(j, "d")
    [h3] = 1
    [j1] = [e1]
    [f3] = Cells(j + 1, "c")
    [g3] = Cells(j + 1, "d")
    [h3] = 1
    [j2] = [e1]
    If [i1] * [i2] <= 0 And [j1] * [j2] <= 0 Then
      [f7] = Cells(i, "a") - [i1] / ([i2] - [i1]) * (Cells(i + 1, "a") - Cells(i, "a"))
      [g7] = Cells(i, "b") - [i1] / ([i2] - [i1]) * (Cells(i + 1, "b") - Cells(i, "b"))
      Exit For
    End If
  Next i
  If [f7] <> "" Or [g7] <> "" Then Exit For
Next j
End Sub
执行后,若有交点则显示在F7:G7