Posted to microsoft.public.excel.worksheet.functions
|
|
intersection of two lines defined by points
Thanks so much!!
"Bernie Deitrick" wrote:
Well, I have found one error - due to the inaccuracies introduced by binary coding and truncation.
If there is a point shared by the two sets, the code and function may not find that obvious solution
due to the rounding introduced by calculation. To check for that, we would need to add this just
after the line Set Y2Vals = Range("D2", Cells(Rows.Count, 4).End(xlUp))
For i = 1 To X1Vals.Cells.Count
For j = 1 To X2Vals.Cells.Count
If X1Vals.Cells(i).Value = X2Vals.Cells(j).Value And _
Y1Vals.Cells(i).Value = Y2Vals.Cells(j).Value Then
MsgBox "A solution is X = " & X1Vals.Cells(i).Value & ", Y = " & Y1Vals.Cells(i).Value
Exit Sub
End If
Next j
Next i
The function would require similar code checking.
HTH,
Bernie
MS Excel MVP
"Bernie Deitrick" <deitbe @ consumer dot org wrote in message
...
Leslie,
Below are two solutions. The first is a macro, written for your data table to start in cell A1
and have headers in row 1 and matched data sets in columns A and B, and columns C and D. Columns
A to D should be otherwise empty. Use Tools / Macro / Macros... and run FindTableIntercept.
The second is a User-Defined Function, which can be used by selecting two adjacent cells, typing
in (based on your example table)
=myIntercept(A2:A8,B2:B8,C2:C4,D2:D4)
and pressing Ctrl-Shift-Enter (array entry of the formula into both cells).
Both the macro and the function should be copied into a regular codemodule in your workbook, and
both give the solution
X = 16.57
Y = 8.45
For your example set.
I'm sure that I haven't handled all the possible ways this could go wrong - that is left as an
exercise for the reader ;-)
HTH,
Bernie
MS Excel MVP
Sub FindTableIntercept()
Dim X1Vals As Range
Dim Y1Vals As Range
Dim X2Vals As Range
Dim Y2Vals As Range
Dim i As Integer
Dim j As Integer
Dim M1 As Double
Dim M2 As Double
Dim B1 As Double
Dim B2 As Double
Dim XVal As Double
Dim YVal As Double
Set X1Vals = Range("A2", Cells(Rows.Count, 1).End(xlUp))
Set Y1Vals = Range("B2", Cells(Rows.Count, 2).End(xlUp))
Set X2Vals = Range("C2", Cells(Rows.Count, 3).End(xlUp))
Set Y2Vals = Range("D2", Cells(Rows.Count, 4).End(xlUp))
On Error GoTo ErrHandler
For i = 2 To X1Vals.Cells.Count
For j = 2 To X2Vals.Cells.Count
M1 = (Y1Vals.Cells(i).Value - Y1Vals.Cells(i - 1).Value) / _
(X1Vals.Cells(i).Value - X1Vals.Cells(i - 1).Value)
M2 = (Y2Vals.Cells(j).Value - Y2Vals.Cells(j - 1).Value) / _
(X2Vals.Cells(j).Value - X2Vals.Cells(j - 1).Value)
B1 = Y1Vals.Cells(i).Value - M1 * X1Vals.Cells(i).Value
B2 = Y2Vals.Cells(j).Value - M2 * X2Vals.Cells(j).Value
XVal = (B2 - B1) / (M1 - M2)
YVal = M1 * XVal + B1
If (XVal = X1Vals.Cells(i - 1).Value And XVal <= X1Vals.Cells(i).Value) And _
(XVal = X2Vals.Cells(j - 1).Value And XVal <= X2Vals.Cells(j).Value) Then
MsgBox "A solution is X = " & XVal & ", Y = " & YVal
Exit Sub
End If
Next j
Next i
MsgBox "An extrapolated solution base on the last two sets is X = " & XVal & ", Y = " & YVal
Exit Sub
ErrHandler:
MsgBox "There is an error with the data set"
End Sub
Function MyIntercept(X1Vals As Range, _
Y1Vals As Range, _
X2Vals As Range, _
Y2Vals As Range) As Variant
Dim i As Integer
Dim j As Integer
Dim M1 As Double
Dim M2 As Double
Dim B1 As Double
Dim B2 As Double
Dim XVal As Double
Dim YVal As Double
Dim mySol(1 To 2) As Double
If (X1Vals.Cells.Count < Y1Vals.Cells.Count) Or _
(X2Vals.Cells.Count < Y2Vals.Cells.Count) Then
MyIntercept = Array("Mismatched", "Cells")
Exit Function
End If
For i = 2 To X1Vals.Cells.Count
For j = 2 To X2Vals.Cells.Count
M1 = (Y1Vals.Cells(i).Value - Y1Vals.Cells(i - 1).Value) / _
(X1Vals.Cells(i).Value - X1Vals.Cells(i - 1).Value)
M2 = (Y2Vals.Cells(j).Value - Y2Vals.Cells(j - 1).Value) / _
(X2Vals.Cells(j).Value - X2Vals.Cells(j - 1).Value)
B1 = Y1Vals.Cells(i).Value - M1 * X1Vals.Cells(i).Value
B2 = Y2Vals.Cells(j).Value - M2 * X2Vals.Cells(j).Value
XVal = (B2 - B1) / (M1 - M2)
YVal = M1 * XVal + B1
If (XVal = X1Vals.Cells(i - 1).Value And XVal <= X1Vals.Cells(i).Value) And _
(XVal = X2Vals.Cells(j - 1).Value And XVal <= X2Vals.Cells(j).Value) Then
mySol(1) = XVal
mySol(2) = YVal
GoTo Output
End If
Next j
Next i
mySol(1) = XVal
mySol(2) = YVal
Output:
If Application.Caller.Rows.Count = 1 Then
MyIntercept = mySol
Else
MyIntercept = Application.Transpose(mySol)
End If
End Function
"Leslie" wrote in message
...
Thanks for the quick response. However, I cannot lump all data points into
one line equation. X values will be in ascending order but not all points
fall within one single line equation. And yes, I also need it to extrapolate
assuming a linear behavior of the last two points of that extrapolation
location. Example points:
x1 y1 x2 y2
1 12 1 0
3 11.8 15 8
4 10 22 10
5.2 9
9 8.9
13 8.5
20 8.4
Thanks again!
"Bernie Deitrick" wrote:
Bernard,
That's what I originally thought, too, until I noted
assuming a linear behavior between points
which I took to mean not using the entire data set for the fit.
Perhaps the OP will clarify...
Bernie
"Bernard Liengme" wrote in message
...
Line 1: y=m1x+c1
Line 2: y=m2x+c2
At the point of intersection the y-values of the two lines are the same as are the x-values.
So we
write
m1x+c1=m2x+c2
This gives (m1-m2)x=c2-c1 or x = (m1-m2)/(c2-c1)
and
y = m1*(m1-m2)/(c2-c1) + c1
In Excel, we can find x with
=(SLOPE(y-values-dataset1,x-values-dataset1 -SLOPE(y-values-dataset2,x-values-dataset2)) /
(INTERCEPT(y-values-dataset2,x-values-dataset2) -
INTERCEPT(y-values-dataset1,x-values-dataset1))
In this is in cell G1, then we find y with
=SLOPE(y-values-dataset1,x-values-dataset1)*G1 + INTERCEPT(y-values-dataset1,x-values-dataset1
best wishes
--
Bernard V Liengme
Microsoft Excel MVP
www.stfx.ca/people/bliengme
remove caps from email
"Leslie" wrote in message
...
I am looking for either a worksheet function or VBA code that would give me
the x and y coordinates of the intersection of two lines defined by points. I
have a list of x's and y's for one data set and a list of x's and y's for
another data set. I need the intersection (x and y) of these two sets of data
assuming a linear behavior between points. Your help woiuld be greatly
appreciated. Thanks!
|