Excel宏识别值的0交叉

Question

A 列中有频率值，B 列有相应的增益值，C 列有相位值。频率范围从 10 到 1e06，而增益从 100 到 -100 变化，相位从 180 到 -180 变化。在单元格 D1 中，我想要增益与 0 交叉的频率 (fc) 值，在单元格 D2 中，我想要 fc 处的相位值。我在在列上运行暴力破解中使用了共享宏，以使用 VBA 来确定值是否跨越某个点。但我无法访问增益超过 0 的频率值。我需要帮助编写代码来访问特定单元格的该值。

这是我用来检测过零的宏。

Sub Tester()
    Dim sht As Worksheet, lastRow As Long, xvals, yvals, r As Long
    Dim th As Double, y1, y2, x1, x2


    Set sht = ActiveSheet
    lastRow = sht.Range("B" & Rows.Count).End(xlUp).Row

    'assumes y vals in "B" and x vals in "A"
    'adjust as rtequired...
    yvals = sht.Range(sht.Cells(14, "B"), sht.Cells(lastRow, "B"))
    xvals = sht.Range(sht.Cells(14, "A"), sht.Cells(lastRow, "A"))

    th = 0

    For r = 1 To UBound(yvals) - 1
        y1 = yvals(r, 1)
        y2 = yvals(r + 1, 1)

        'pair of points crosses the threshold?
        If IsNumeric(y1) And IsNumeric(y2) Then
            If (y1 < th And y2 > th) Or (y1 > th And y2 < th) Then
                x1 = xvals(r, 1)
                x2 = xvals(r + 1, 1)
                '*************
                'calculate the intercept
                '*************
            End If
        End If
    Next r
End Sub

Answer 1

我希望您发布了数据样本以了解数据如何变化。 也许对数标度更适合频率。

如果您正在寻找一个零点，请按如下方式更新您的代码。

Sub Tester()
    Dim sht As Worksheet, lastRow As Long, xvals, yvals, r As Long
    Dim th As Double, y1, y2, x1, x2
    Dim zvals, z1, z2, z0, x0     ' added

    Set sht = ActiveSheet
    lastRow = sht.Range("B" & Rows.Count).End(xlUp).Row

    'assumes y vals in "B" and x vals in "A"
    'adjust as rtequired...
    yvals = sht.Range(sht.Cells(14, "B"), sht.Cells(lastRow, "B"))
    xvals = sht.Range(sht.Cells(14, "A"), sht.Cells(lastRow, "A"))
    zvals = sht.Range("C14:C" & lastRow).Value    ' added

    th = 0

    For r = 1 To UBound(yvals) - 1
        y1 = yvals(r, 1)
        y2 = yvals(r + 1, 1)

        'pair of points crosses the threshold?
        If IsNumeric(y1) And IsNumeric(y2) Then
            If (y1 < th And y2 > th) Or (y1 > th And y2 < th) Then
                x1 = xvals(r, 1)
                x2 = xvals(r + 1, 1)
                z1 = zvals(r, 1)      ' added
                z2 = zvals(r + 1, 1)  ' added
                '*************
                'calculate the intercept
                '*************
                x0 = (x2 * y1 - x1 * y2 + th * (x1 - x2)) / (y1 - y2)  ' added
                z0 = (x2 * z1 - x1 * z2 + x0 * (z2 - z1)) / (x2 - x1)  ' added
                sht.Range("D1").Value = x0           ' added
                sht.Range("D2").Value = z0           ' added
                Exit For                 ' added
            End If
        End If
    Next r
End Sub