Author Topic: Evidenziazione  (Read 3759 times)

0 Members and 1 Guest are viewing this topic.

Offline afazio

  • Veterano del forum
  • ****
  • Posts: 663
  • Karma: 273
  • dovizio mi delizio
    • CI si vede al Bar
Evidenziazione
« on: 17 April , 2012, 21:55:57 PM »
provate a mettere questo codice

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target _
 As Excel.Range)
    Cells.Interior.ColorIndex = xlNone
    With ActiveCell
        .EntireRow.Interior.ColorIndex = 27
        .EntireColumn.Interior.ColorIndex = 27
    End With
End Sub

all'interno del progetto excel selezionando un foglio qualsiasi.

« Ogni qualvolta una teoria ti sembra essere l’unica possibile, prendilo come un segno che non hai capito né la teoria né il problema che si intendeva risolvere. »
K.P.

Offline quattropassi

  • Esperto del forum
  • ***
  • Posts: 226
  • Karma: 49
  • Neo - Laureato
Re: Evidenziazione
« Reply #1 on: 17 April , 2012, 22:56:59 PM »
 :mmm:
a occhio direi che picchiando una cella ti farà gialla la colonna e la riga...
mo' provo

 :ciau:
* Se ci scambiamo un dollaro, ognuno rimane con un dollaro.
* Se ci scambiano un'informazione, ognuno rimane con due informazioni.

Offline quattropassi

  • Esperto del forum
  • ***
  • Posts: 226
  • Karma: 49
  • Neo - Laureato
Re: Evidenziazione
« Reply #2 on: 17 April , 2012, 22:59:01 PM »
... che si potrebbe variare anche con un comando scroll per portare la cella picchiata (p es) in alto a sn.
Tanto per averla sempre a tiro... ma può anche essere fastidioso...  :asd:
* Se ci scambiamo un dollaro, ognuno rimane con un dollaro.
* Se ci scambiano un'informazione, ognuno rimane con due informazioni.

Offline afazio

  • Veterano del forum
  • ****
  • Posts: 663
  • Karma: 273
  • dovizio mi delizio
    • CI si vede al Bar
Re: Evidenziazione
« Reply #3 on: 18 April , 2012, 16:26:37 PM »
:mmm:
a occhio direi che picchiando una cella ti farà gialla la colonna e la riga...
mo' provo

 :ciau:

uhmm hai un buon occhio
« Ogni qualvolta una teoria ti sembra essere l’unica possibile, prendilo come un segno che non hai capito né la teoria né il problema che si intendeva risolvere. »
K.P.

Offline quattropassi

  • Esperto del forum
  • ***
  • Posts: 226
  • Karma: 49
  • Neo - Laureato
Re: Evidenziazione
« Reply #4 on: 18 April , 2012, 19:13:27 PM »
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.

Code: [Select]
'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

* Se ci scambiamo un dollaro, ognuno rimane con un dollaro.
* Se ci scambiano un'informazione, ognuno rimane con due informazioni.

 

Sitemap 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24