cmq personalizzare il menu contestuale è la cosa più interessante secondo me.
... quantunque per navigare in matricione possa essere ben utile la croce gialla.
L'interessante però è che serve a capire gil eventi dello sheet: quelli son utili anzichenò.
Concordo.
Avevi preso (da qualche parte lo postai) l'interpolazione fra due valori?
Ricordo l'applicai per l'uggiosa tabella fi di mi lambda delle murature. Una UDF fighissima.
'http://www.tushar-mehta.com/excel/newsgroups/interpolation/index.html
'**********************************************************************
Option Explicit
Option Compare Text
Function RealEqual(X, Y) As Boolean
RealEqual = Abs(X - Y) <= 0.00000001
End Function
Function LinearInterp(XVals, YVals, TargetVal)
Dim MatchVal
On Error GoTo ErrXit
With Application.WorksheetFunction
MatchVal = .Match(TargetVal, XVals, 1)
If MatchVal = XVals.Cells.Count _
And RealEqual(TargetVal, .Index(XVals, MatchVal)) Then
LinearInterp = .Index(YVals, MatchVal)
Else
LinearInterp = .Index(YVals, MatchVal) _
+ (.Index(YVals, MatchVal + 1) - .Index(YVals, MatchVal)) _
/ (.Index(XVals, MatchVal + 1) _
- .Index(XVals, MatchVal)) _
* (TargetVal - .Index(XVals, MatchVal))
End If
End With
Exit Function
ErrXit:
With Err
LinearInterp = .Description & "(Number= " & .Number & ")"
End With
End Function
Option Base 0
Function CellAreaDecode(aRng, ByVal I As Long) As Range
Dim AreaI As Long
For AreaI = 1 To aRng.Areas.Count
If I <= aRng.Areas(AreaI).Cells.Count Then
Set CellAreaDecode = aRng.Areas(AreaI).Cells(I)
Exit Function
Else
I = I - aRng.Areas(AreaI).Cells.Count
End If
Next AreaI
End Function
Sub MapIn(InVal, ByRef Where)
Dim I As Integer, HowMany As Integer
If Not (TypeOf InVal Is Range) Then
Where = InVal
ElseIf InVal.Areas.Count = 1 Then
If InVal.Cells.Count = 1 Then
Where = InVal.Value
ElseIf InVal.Columns.Count = 1 Then
Where = Application.WorksheetFunction.Transpose(InVal.Value)
Else
Where = Application.WorksheetFunction.Transpose( _
Application.WorksheetFunction.Transpose(InVal.Value))
End If
Else
HowMany = InVal.Cells.Count
ReDim Where(HowMany - 1)
For I = 0 To HowMany - 1
Where(I) = CellAreaDecode(InVal, I + 1).Value
Next I
End If
End Sub
Function Interpolate2D(InF, InX, InY, InX2, InY2)
'InX contains two values, x0 and x1 _
InY contains two values, y0 and y1 _
InF contains 4 values, defined at (x0,y0), (x0,y1), _
(x1,y0), (x1,y1) _
InX2 and InY2 define the point at which the value of _
the function is required
'tests to ensure x0<x2<x1 and 'y0<y2<y1 needed
Dim F, X, Y, _
X2 As Double, Y2 As Double
Dim NoXVals(1)
MapIn InF, F
MapIn InX, X
MapIn InY, Y
MapIn InX2, X2
MapIn InY2, Y2
NoXVals(0) = (F(2) - F(0)) / (X(1) - X(0)) * (X2 - X(0)) + F(0)
NoXVals(1) = (F(3) - F(1)) / (X(1) - X(0)) * (X2 - X(0)) + F(1)
Interpolate2D = _
(NoXVals(1) - NoXVals(0)) / (Y(1) - Y(0)) * (Y2 - Y(0)) _
+ NoXVals(0)
End Function
Function Interpolate2DArray(InF, InX, InY, InX2, InY2)
'Arguments should be in the following format. However, currently _
there is no validation of the arguments. _
Each of the arguments can be either a range or an array. _
InX is a single dimension array of x values sorted ascending. _
InY is a single dimension array of y values sorted ascending. _
InF is a 2D array with 1 entry for each (X, Y) pair of values in _
the InX and InY arrays. _
InX2 is a single value. _
InY2 is a single value.
Dim F, X, Y, _
X2 As Double, Y2 As Double, _
XIdx As Long, YIdx As Long
Dim NoXVals(1)
MapIn InF, F
MapIn InX, X
MapIn InY, Y
MapIn InX2, X2
MapIn InY2, Y2
On Error GoTo ErrXit
XIdx = Application.WorksheetFunction.Match(X2, X, 1)
YIdx = Application.WorksheetFunction.Match(Y2, Y, 1)
If XIdx = UBound(X) And RealEqual(X2, X(XIdx)) Then
If YIdx = UBound(Y) And RealEqual(Y2, Y(YIdx)) Then
Interpolate2DArray = F(XIdx, YIdx)
Else
Interpolate2DArray = F(XIdx, YIdx) _
+ (F(XIdx, YIdx + 1) - F(XIdx, YIdx)) _
/ (Y(YIdx + 1) - Y(YIdx)) * (Y2 - Y(YIdx))
End If
ElseIf YIdx = UBound(Y) And RealEqual(Y2, Y(YIdx)) Then
Interpolate2DArray = F(XIdx, YIdx) _
+ (F(XIdx + 1, YIdx) - F(XIdx, YIdx)) _
/ (X(XIdx + 1) - X(XIdx)) * (X2 - X(XIdx))
Else
NoXVals(0) = F(XIdx, YIdx) _
+ (F(XIdx + 1, YIdx) - F(XIdx, YIdx)) _
/ (X(XIdx + 1) - X(XIdx)) * (X2 - X(XIdx))
NoXVals(1) = F(XIdx, YIdx + 1) _
+ (F(XIdx + 1, YIdx + 1) - F(XIdx, YIdx + 1)) _
/ (X(XIdx + 1) - X(XIdx)) * (X2 - X(XIdx))
Interpolate2DArray = NoXVals(0) _
+ (NoXVals(1) - NoXVals(0)) _
/ (Y(YIdx + 1) - Y(YIdx)) * (Y2 - Y(YIdx))
End If
Exit Function
ErrXit:
With Err
Interpolate2DArray = .Description & "(Number= " & .Number & ")"
End With
End Function
