Pagina 1 di 1
[Risolto] trova e sostituisci valori
Inviato: venerdì 5 settembre 2014, 14:07
da b1313
Ciao!
ho una colonna che contiene valori separati da virgola.
vorrei che nella colonna a fianco mi uscissero i valori sostituiti (come esempio colonna RISULTATO) seguendo una legenda creata nel Foglio2.
qualcuno mi può aiutare con una macro?
allego un esempio del file.
grazie
Re: trova e sostituisci valori
Inviato: venerdì 5 settembre 2014, 16:21
da Gaetanopr
Bisogna definire l'area del secondo foglio "A2:B11" con il nome "TABELLA"
Codice: Seleziona tutto
Sub Main
Dim Riscontri()
Dim svc As Object
doc=thiscomponent
Sh1 = Doc.Sheets(0)
Sh2 = Doc.Sheets(1)
c = Sh1.createCursor
c.gotoEndOfUsedArea(false)
LastRow = c.RangeAddress.EndRow
svc = createUnoService("com.sun.star.sheet.FunctionAccess")
Tabella = Sh2.getCellRangeByName("TABELLA")
For i = 1 to LastRow
x = 0
oCell1 = Sh1.getCellByPosition(0, i)
Array1 = Split(oCell1.String,",")
For n = Lbound(Array1) To Ubound(Array1)
vlook = svc.callFunction("VLOOKUP",Array(Array1(n), Tabella, 2, False))
If IsEmpty(vlook) = False Then
Redim Preserve Riscontri(0 to x)
Riscontri(x) = vlook
x = x + 1
End If
Next n
If x > 0 Then
Sh1.getCellByPosition(2, i).String = Join( Riscontri(), "," )
Else
Sh1.getCellByPosition(2, i).String = ""
End if
Next i
End Sub
Re: trova e sostituisci valori
Inviato: lunedì 8 settembre 2014, 9:31
da b1313
Ciao!
grazie per l'aiuto.
Ho provato la macro aggiungendo dei valori nel foglio TABELLA, non so se sbaglio io, ma salta i valori dopo il 10, come vedi nel file allegato.
grazie
Gaetanopr ha scritto:Bisogna definire l'area del secondo foglio "A2:B11" con il nome "TABELLA"
Codice: Seleziona tutto
Sub Main
Dim Riscontri()
Dim svc As Object
doc=thiscomponent
Sh1 = Doc.Sheets(0)
Sh2 = Doc.Sheets(1)
c = Sh1.createCursor
c.gotoEndOfUsedArea(false)
LastRow = c.RangeAddress.EndRow
svc = createUnoService("com.sun.star.sheet.FunctionAccess")
Tabella = Sh2.getCellRangeByName("TABELLA")
For i = 1 to LastRow
x = 0
oCell1 = Sh1.getCellByPosition(0, i)
Array1 = Split(oCell1.String,",")
For n = Lbound(Array1) To Ubound(Array1)
vlook = svc.callFunction("VLOOKUP",Array(Array1(n), Tabella, 2, False))
If IsEmpty(vlook) = False Then
Redim Preserve Riscontri(0 to x)
Riscontri(x) = vlook
x = x + 1
End If
Next n
If x > 0 Then
Sh1.getCellByPosition(2, i).String = Join( Riscontri(), "," )
Else
Sh1.getCellByPosition(2, i).String = ""
End if
Next i
End Sub
Re: trova e sostituisci valori
Inviato: lunedì 8 settembre 2014, 9:36
da Gaetanopr
Gaetanopr ha scritto:Bisogna definire l'area del secondo foglio "A2:B11" con il nome "TABELLA"
L'area che avevo definito arriva alla cella B11 se allunghi la tabella devi pure modificare l'area di questa andando su Inserisci - Nomi - Definisci - selezioni TABELLA e modifichi il range
Altrimenti cambia la macro in questo modo, così non c'è bisogno di definire il nome "TABELLA"
Codice: Seleziona tutto
Sub Main
Dim Riscontri()
Dim svc As Object
doc=thiscomponent
Sh1 = Doc.Sheets.getByName("Foglio1")
Sh2 = Doc.Sheets.getByName("TABELLA")
c = Sh1.createCursor
c.gotoEndOfUsedArea(false)
LastRow = c.RangeAddress.EndRow
a = Sh2.createCursor
a.gotoEndOfUsedArea(false)
LastRow2 = a.RangeAddress.EndRow
svc = createUnoService("com.sun.star.sheet.FunctionAccess")
Tabella = Sh2.getCellRangeByName("A2:B" & LastRow2+1)
For i = 1 to LastRow
x = 0
oCell1 = Sh1.getCellByPosition(0, i)
Array1 = Split(oCell1.String,",")
For n = Lbound(Array1) To Ubound(Array1)
vlook = svc.callFunction("VLOOKUP",Array(Array1(n), Tabella, 2, False))
If IsEmpty(vlook) = False Then
Redim Preserve Riscontri(0 to x)
Riscontri(x) = vlook
x = x + 1
End If
Next n
If x > 0 Then
Sh1.getCellByPosition(1, i).String = Join( Riscontri(), "," )
Else
Sh1.getCellByPosition(1, i).String = ""
End if
Next i
End Sub
Re: trova e sostituisci valori
Inviato: lunedì 8 settembre 2014, 12:18
da b1313
perfetto grazie!
| Editato: Eliminata citazione, perchè inutile (moderatore charlie) |