Author Topic: [excel] ricerca valori multipli  (Read 4405 times)

0 Members and 1 Guest are viewing this topic.

Offline melo

  • Semi Esperto
  • **
  • Posts: 146
  • Karma: 11
  • Novizio
[excel] ricerca valori multipli
« on: 17 September , 2012, 17:00:37 PM »
Ho una matrice in excel dove nella prima colonna sono presenti degli indici e nella seconda dei testi.
Devo scrivere in un'altra colonna i valori che corrispondono all'indice.

Esempio:

In un altra matrice


Mettendo nella colonna il valore 1 mi deve restituire quello che c'è nella colonna blu.

Se mettessi 4 al posto di 1, mi dovrebbe dare gatto e cavallo
"Non prendere la vita troppo sul serio, tanto non ne uscirai vivo!" 

Offline quattropassi

  • Esperto del forum
  • ***
  • Posts: 226
  • Karma: 49
  • Neo - Laureato
Re:[excel] ricerca valori multipli
« Reply #1 on: 20 September , 2012, 19:59:34 PM »
Visto che non t'han risposto... ce provo io  :mmm:
Visto che sei pratico di matrici ne ho buttata giù una rozza.
Ho usato la UDF SortV presa da un sito che linko nel modulo delle macro.


Il foglio sviluppato lo trovi qui:
https://www.box.com/s/oz3kyxmnsoddu3r71mdl

Il codice della UDF:
Code: [Select]
Option Explicit



Public Function SortV(ByRef sortrange As Variant, Optional SortBy As Long, Optional Order As Long = 1) As Variant
' http://newtonexcelbach.wordpress.com/2009/03/23/a-sort-function/

'Default:
'Sort Column =1
'Direction = 1 = Ascending   anytingh else = descending

    Dim iSpacing As Long
    Dim iOuter As Long
    Dim iInner As Long
    Dim iLBound As Long
    Dim iUBound As Long
    Dim iFinished As Long
    Dim numcols As Long, Swap As Long, Swaprtn As Long
    Dim Firstcol As Long, LastCol As Long
   
    If TypeName(sortrange) = "Range" Then sortrange = sortrange.Value2
   
    iLBound = LBound(sortrange)
    iUBound = UBound(sortrange)
    Firstcol = LBound(sortrange, 2)
    LastCol = UBound(sortrange, 2)
    If SortBy = 0 Then SortBy = Firstcol
       
   
    'Initialise comb width
    iSpacing = iUBound - iLBound
   
    Do
        If iSpacing > 1 Then
            iSpacing = Int(iSpacing / 1.3)
           
            If iSpacing = 0 Then
                iSpacing = 1  'Dont go lower than 1
            ElseIf iSpacing > 8 And iSpacing < 11 Then
                iSpacing = 11 'This is a special number, goes faster than 9 and 10
            End If
        End If
       
        'Always go down to 1 before attempting to exit
        If iSpacing = 1 Then iFinished = 1
       
        'Combing pass
        For iOuter = iLBound To iUBound - iSpacing
            iInner = iOuter + iSpacing
           
            If Order = 1 Then
            If sortrange(iOuter, SortBy) > sortrange(iInner, SortBy) Then Swap = 1
            Else
            If sortrange(iOuter, SortBy) < sortrange(iInner, SortBy) Then Swap = 1
            End If
            If Swap = 1 Then
                Swaprtn = SwapRows(sortrange, iOuter, iInner, Firstcol, LastCol)
                Swap = 0
                'Not finished
                iFinished = 0
            End If
        Next iOuter
       
    Loop Until iFinished
    SortV = sortrange
End Function

Function SwapRows(SwapArray As Variant, Row1 As Long, Row2 As Long, Firstcol As Long, LastCol As Long) As Long
Dim i As Long, Temp As Variant

                For i = Firstcol To LastCol
                Temp = SwapArray(Row1, i)
                SwapArray(Row1, i) = SwapArray(Row2, i)
                SwapArray(Row2, i) = Temp
                Next i
If i = LastCol Then SwapRows = 0 Else SwapRows = i
End Function


Function QuickSort2DArray(VarArray As Variant, lSortColumn As Long, Optional sOrder As String = "A", _
                          Optional lngFirst As Long = -1, Optional lngLast As Long = -1) As Variant
                         
' By  RB Smissaert; http://groups.google.com/group/microsoft.public.excel.programming/browse_thread/thread/364c173e716998b2#


  Dim c As Long
  Dim lngLow As Long
  Dim lngHigh As Long
  Dim lngMiddle As Long
  Dim varTempVal As Variant
  Dim varTestVal As Variant


  If lngFirst = -1 Then lngFirst = LBound(VarArray)
  If lngLast = -1 Then lngLast = UBound(VarArray)


  lngMiddle = (lngFirst + lngLast) / 2
  varTestVal = VarArray(lngMiddle, lSortColumn)
  lngLow = lngFirst
  lngHigh = lngLast


  Do
    If sOrder = "A" Then
      Do While VarArray(lngLow, lSortColumn) < varTestVal
        lngLow = lngLow + 1
      Loop
      Do While VarArray(lngHigh, lSortColumn) > varTestVal
        lngHigh = lngHigh - 1
      Loop
    Else
      Do While VarArray(lngLow, lSortColumn) > varTestVal
        lngLow = lngLow + 1
      Loop
      Do While VarArray(lngHigh, lSortColumn) < varTestVal
        lngHigh = lngHigh - 1
      Loop
    End If


    If (lngLow <= lngHigh) Then
      'swap the array rows
      '-------------------
      For c = LBound(VarArray, 2) To UBound(VarArray, 2)
        varTempVal = VarArray(lngLow, c)
        VarArray(lngLow, c) = VarArray(lngHigh, c)
        VarArray(lngHigh, c) = varTempVal
      Next c


      lngLow = lngLow + 1
      lngHigh = lngHigh - 1
    End If


  Loop While (lngLow <= lngHigh)


  If lngFirst < lngHigh Then
    QuickSort2DArray VarArray, lSortColumn, sOrder, lngFirst, lngHigh
  End If


  If lngLow < lngLast Then
    QuickSort2DArray VarArray, lSortColumn, sOrder, lngLow, lngLast
  End If


End Function


Function QSort(sortrange As Variant, SortCol As Long, Order As Long)
Dim ierr As Long, AlphOrder As String
If Order = 1 Then AlphOrder = "A" Else AlphOrder = "D"
 If TypeName(sortrange) = "Range" Then sortrange = sortrange.Value2
ierr = QuickSort2DArray(sortrange, SortCol, AlphOrder)
QSort = sortrange
End Function


Sub testsortv()
Dim sortrange As Variant, zsort() As Variant, first As Long, last As Long
Dim i As Long, j As Long

sortrange = [I8:O29].Value
ReDim zsort(0 To 21, 0 To 6)

For i = 1 To 22
For j = 1 To 7
zsort(i - 1, j - 1) = sortrange(i, j)
Next j
Next i

zsort = SortV(zsort, 6)

[I31:O50].Value = zsort

End Sub

Mi pare funzioni.
Ho messo nel  foglio la forma "lunga" e quella "compatta".

Poi ci sono anche alternative.
 :byebye:
* 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