如何用宏定义可公式引用的动态命名范围以实现指数曲线拟合

Let's break down how to solve your problem step by step—your goal is to create dynamic named ranges for valid X/Y data (ignoring rows with zero or missing depth values) so your exponential fitting formulas work reliably, and fix the broken VBA code you've written.

First, Diagnose Your Sorting_x Code Issues #

Your current macro has a few syntax and logic bugs that are causing it to fail:

• Variable typo: You defined myRangeNamex but tried to use mRangeNamex when adding the named range
• Redundant range referencing: Xlong.Range.Cells(i, 1) is unnecessary—you can directly use Xlong.Cells(i, 1)
• Uninitialized range: Xshort starts as Nothing, so using Union on it will throw an error immediately
• Fixed loop range: Hardcoding To 23 means the macro won't adapt as you add more rows of data

Solution 1: Updated VBA Code for Dynamic Named Ranges #

This macro will dynamically find all valid rows (where Y value is positive and non-empty), collect the corresponding X and Y values, then create named ranges Xvalues and Yvalues that update automatically as you add data:

Sub CreateDynamicNamedRanges()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim xCol As Integer, yCol As Integer
    Dim xRange As Range, yRange As Range
    Dim i As Long
    
    ' Set your target worksheet (change to your actual sheet name)
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    ' Define columns for X (time) and Y (depth) data
    xCol = 2 ' Column B
    yCol = 3 ' Column C
    
    ' Find the last row with data in the X column
    lastRow = ws.Cells(ws.Rows.Count, xCol).End(xlUp).Row
    
    ' Initialize ranges to avoid errors
    Set xRange = Nothing
    Set yRange = Nothing
    
    ' Loop through rows to collect valid data points
    For i = 2 To lastRow ' Start at row 2 assuming headers are in row 1
        If ws.Cells(i, yCol).Value > 0 And Not IsEmpty(ws.Cells(i, yCol).Value) Then
            If xRange Is Nothing Then
                Set xRange = ws.Cells(i, xCol)
                Set yRange = ws.Cells(i, yCol)
            Else
                Set xRange = Union(xRange, ws.Cells(i, xCol))
                Set yRange = Union(yRange, ws.Cells(i, yCol))
            End If
        End If
    Next i
    
    ' Delete existing named ranges to avoid duplicates
    On Error Resume Next
    ThisWorkbook.Names("Xvalues").Delete
    ThisWorkbook.Names("Yvalues").Delete
    On Error GoTo 0
    
    ' Create new dynamic named ranges
    If Not xRange Is Nothing Then
        ThisWorkbook.Names.Add Name:="Xvalues", RefersTo:=xRange
        ThisWorkbook.Names.Add Name:="Yvalues", RefersTo:=yRange
        MsgBox "Dynamic named ranges created successfully!"
    Else
        MsgBox "No valid data found (all Y values are zero or empty)!"
    End If
End Sub

How to Use This: #

1. Replace "Sheet1" with your actual worksheet name
2. Adjust xCol and yCol to match your X (time) and Y (depth) columns
3. Run the macro after adding new data, or tie it to a Worksheet_Change event to auto-update when you edit data

Solution 2: Fix Your Exponential Fitting Formula #

Your current formula fails with zero values because LN(0) returns a #NUM! error. Modify it to skip invalid values directly in the formula:

=EXP(INDEX(LINEST(LN(IF(Yvalues>0,Yvalues,"")),Xvalues),1,2))
=INDEX(LINEST(LN(IF(Yvalues>0,Yvalues,"")),Xvalues),1)

The IF(Yvalues>0,Yvalues,"") clause tells Excel to ignore zero/empty Y values, so LN() only runs on valid positive numbers.

Alternative: Dynamic Named Ranges Without VBA #

If you prefer avoiding macros, create dynamic named ranges using Excel's built-in formulas:

1. Go to Formulas > Define Name
2. For Xvalues, set Refers to:

   =OFFSET(Sheet1!$B$2,0,0,COUNTA(Sheet1!$B:$B)-1,1)
   

3. For Yvalues, set Refers to:

   =OFFSET(Sheet1!$C$2,0,0,SUMPRODUCT(--(Sheet1!$C$2:$C$1000>0)),1)
   

   Note: Adjust $C$1000 to a row number well above your maximum expected data rows

This will automatically expand/contract as you add valid Y values.

内容的提问来源于stack exchange，提问作者ClaireY