Moderatori: Anthony47, Flash30005
=INDIRETTO(INDIRIZZO(RIF.COLONNA(A$1)+1;1;;;"Editori"))&""
=SE(VAL.ERRORE(SE(A$2="";"";INDICE(Editori!$C$2:$C$101;PICCOLO(SE(VAL.NUMERO(TROVA(A$2;Editori!$C$2:$C$101));RIF.RIGA($2:$101)-1);RIF.RIGA($A1)))));"";SE(A$2="";"";INDICE(Editori!$C$2:$C$101;PICCOLO(SE(VAL.NUMERO(TROVA(A$2;Editori!$C$2:$C$101));RIF.RIGA($2:$101)-1);RIF.RIGA($A1)))))
=SE(C2="";"";SE(VAL.ERRORE(SE(VAL.ERRORE(CERCA.VERT($C2&"*";$A$2:$C$101;1;0));INDICE(Foglio1!$A$2:$CV$2;PICCOLO(SE(Foglio1!$A$3:$CV$102=$C2;RIF.COLONNA($A:$CV));1));CERCA.VERT($C2&"*";$A$2:$C$101;1;0)));"";SE(VAL.ERRORE(CERCA.VERT($C2&"*";$A$2:$C$101;1;0));INDICE(Foglio1!$A$2:$CV$2;PICCOLO(SE(Foglio1!$A$3:$CV$102=$C2;RIF.COLONNA($A:$CV));1));CERCA.VERT($C2&"*";$A$2:$C$101;1;0))))
Sub BestGuess()
Dim splArr(), wArr, sSh As Worksheet, toSplit As String
Dim I As Long, J As Long, mySplit, splInd As Long
Dim LastR As Long, ElencoA As String, ElencoB As String
Dim K As Long, L As Long, myMatch
Dim cPeso As Single, tPeso As Single, maxI As Long, maxPeso As Single
Dim lMc As Long, lWc As Long
'
ElencoA = "A2" '<<< L'inizio dell'elenco "giusto"
ElencoB = "C2" '<<< L'inizio dell'elenco da confrontare
colp = "F" '<<< La colonna per inserire il "peso"
colg = "G" '<<< La colonna per inserire la "migliore ipotesi"
'
remov = Array(",", "'", "&", "-")
pesi = Array("EDITORE", 0.6, "LA", 0.1, "LE", 0.1, "I", 0.1, "GLI", 0.1, "L", 0.1, "E", 0.1)
'
Set sSh = ThisWorkbook.Sheets("Editori")
LastR = sSh.Range(ElencoA).Offset(10000, 0).End(xlUp).Row
wArr = sSh.Range(ElencoA).Resize(LastR - 1, 1).Value
ReDim splArr(1 To UBound(wArr), 1 To 6)
For I = 1 To UBound(wArr)
toSplit = UCase(wArr(I, 1) & " #")
For J = 0 To UBound(remov)
toSplit = Replace(toSplit, remov(J), " ", , , vbTextCompare)
Next J
mySplit = Split(toSplit, " ", , vbTextCompare)
If UBound(mySplit) > 0 Then
splInd = 1
For J = 0 To UBound(mySplit)
If Len(mySplit(J)) > 0 Then
splArr(I, splInd) = mySplit(J)
splInd = splInd + 1
If splInd > 6 Then Exit For
End If
Next J
End If
Next I
LastR = sSh.Range(ElencoB).Offset(10000, 0).End(xlUp).Row
'
For I = 1 To LastR - 1
maxPeso = 0
toSplit = UCase(sSh.Range(ElencoB).Cells(I, 1))
For J = 0 To UBound(remov)
toSplit = Replace(toSplit, remov(J), " ", , , vbTextCompare)
Next J
mySplit = Split(Application.WorksheetFunction.Trim(toSplit), " ", , vbTextCompare)
For J = 1 To UBound(splArr)
aaaa = wArr(J, 1)
tPeso = 0: lMc = 0: lWc = 0
For K = 1 To UBound(splArr, 2)
bbbb = splArr(J, K)
If Len(splArr(J, K)) < 1 Then Exit For
lWc = lWc + 1
For L = 0 To UBound(mySplit)
If splArr(J, K) = mySplit(L) Then
lMc = lMc + 1
myMatch = Application.Match(mySplit(L), pesi, False)
If IsError(myMatch) Then
cPeso = 1 * Len(mySplit(L))
Else
cPeso = pesi(myMatch) * Len(mySplit(L))
End If
tPeso = tPeso + cPeso
End If
Next L
Next K
If lWc > 1 Then
If lMc > UBound(mySplit) Then addp = 10 Else addp = 0
If (tPeso * lMc / (lWc - 1)) + addp > maxPeso And lWc > 1 Then
maxPeso = tPeso * lMc / (lWc - 1) + addp
' If lMc >= UBound(mySplit) Then maxPeso = maxPeso + 10
maxI = J
End If
End If
Next J
If maxPeso > 0 Then
sSh.Cells(I + Range(ElencoB).Row - 1, "G").Value = Range(ElencoA).Cells(maxI, 1)
sSh.Cells(I + Range(ElencoB).Row - 1, "F").Value = maxPeso
Else
sSh.Cells(I + Range(ElencoB).Row - 1, "F").Value = 0
sSh.Cells(I + Range(ElencoB).Row - 1, "G").ClearContents
End If
Next I
End Sub
Torna a Applicazioni Office Windows
Inserire add.in nella barra di avvio veloce in excel 2003 Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 4 |
Excel: problema con date se devo unirle a testi Autore: valle1975 |
Forum: Applicazioni Office Windows Risposte: 5 |
confrontare e evidenziare 2 fogli excel Autore: niccia |
Forum: Applicazioni Office Windows Risposte: 7 |
Visitano il forum: Nessuno e 10 ospiti