Surface charts with empty cells

  • Thread starter Thread starter Sortawired
  • Start date Start date
S

Sortawired

Is there a way to have a surface chart, in 3D or 2D,
interpolate empty cells. I've tried the interpolate macro
with no success, as all interpolation functions I've found
so far seem to only work on a single series at once.
 
Maybe you are having a hard time finding any interpolation routines for
1D because there aren't that many available.
Click to expand...

Also, before you start using the suggestion below, do remember that an
XL surface chart is actually based on 'category' axes, and the x- and
y-axes are not true numeric scales.

For a crude function that uses straight-line / flat-surface
interpolation, use the code below. The first two functions are support
functions, the 3rd does the interpolation, and the last Sub is for a
simple test.

To use this in an XL worksheet, suppose you have a sheet set up with
values in B4:E7 as:

x\y 0 1 2
0 0 2
1
2 2 4

Plot B4:E7 as a surface plot.

To fill in the values for the missing data points, in D5 (below the 1
and to the right of the zero), enter
=Interpolate2D(($C$5,$E$5,$C$7,$E$7),($B$5,$B$7),($C$4,$E$4),$B5,D$4)
Copy D5 to D6:D7. Copy D6 to C6, E6.

The code below goes into a standard module.

Option Explicit
Option Base 1
Function CellAreaDecode(x, ByVal i As Long) As Range
Dim AreaI As Long
For AreaI = 1 To x.Areas.Count
If i <= x.Areas(AreaI).Cells.Count Then
Set CellAreaDecode = x.Areas(AreaI).Cells(i)
Exit Function
Else
i = i - x.Areas(AreaI).Cells.Count
End If
Next AreaI
End Function
Sub MapIn(InVal, ByRef Where, ByVal HowMany)
Dim i As Integer
If Not (TypeOf InVal Is Range) Then
Where = InVal
ElseIf HowMany = 1 Then
Where = InVal.Cells(1).Value
Else
ReDim Where(1 To HowMany)
For i = 1 To HowMany
Where(i) = CellAreaDecode(InVal, i).Value
Next i
End If
End Sub
Function Interpolate2D(InF, InX, InY, InX1, InY1)
'X contains two values, x0 and x1 _
Y contains two values, y0 and y1 _
F contains 4 values, defined at (x0,y0), (x0,y2), _
(x2,y0), (x2,y2) _
x1 and y1 define the point at which the value of _
the function is required
'tests to ensure x0<x1<x2 and 'y0<y1<y1 needed
Dim F, x, Y, _
X1 As Double, Y1 As Double
Dim NoXvals(1 To 2)
MapIn InF, F, 4
MapIn InX, x, 2
MapIn InY, Y, 2
MapIn InX1, X1, 1
MapIn InY1, Y1, 1
NoXvals(1) = (F(3) - F(1)) / (x(2) - x(1)) * (X1 - x(1)) + F(1)
NoXvals(2) = (F(4) - F(2)) / (x(2) - x(1)) * (X1 - x(1)) + F(2)
Interpolate2D = _
(NoXvals(2) - NoXvals(1)) / (Y(2) - Y(1)) * (Y1 - Y(1)) _
+ NoXvals(1)
End Function

Sub testIt()
MsgBox Interpolate2D(Array(0, 2, 2, 4), Array(0, 2), _
Array(0, 2), 1, 1)
End Sub


--
Regards,

Tushar Mehta, MS MVP -- Excel
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions
 
Back
Top