Il ragionamento che hai descritto e' un vizio troppo comune: si pensa poco, si fatica tanto, si conclude poco.
Volendo rispettare il tuo desiderio per un' ultima versione del progetto vorrei capire meglio quali dati vorresti presentare nel caso di spunta di quest' ultima casella; A-B-C-D non mi quadra, sia perche' parlando di "due celle immediatamente dopo" mi sarei immaginato di trovare 3 celle in tutto e non 4, sia perche' la ricerca noi l' abbiamo fatta in due intervalli (AB3:AB100, A3:B2000), quindi immagino siano da prendere in considerazione anche le colonne AC-AD.
Per quanto riguarda il discorso degli accenti anche qui temo che l' analisi sia carente: vuoi dire che non avrai nomi con l' umlaut (es Löwe) o con la tilde (es Niño) o con la cediglia (es Maçon) o con il circonflesso (Bârre) o tutte le complicazioni nella traslitterazione di nomi arabi in caratteri latini, o quelle degli alfabeti nordici o slavi o...
Cio' detto, ho sviluppato la funzione di conversione "ChrConv"; per prova l' ho specializzata a convertire solo alcune combinazioni; ho modificato la macro pubblicata ieri sera per inserire l' utilizzo di questa funzione.
Per specializzare la conversione dovrai elencare i caratteri/le combinazioni da convertire e l' equivalente; ad esempio io ho usato
- Codice: Seleziona tutto
è e' é E' È Mc 'Caratteri da convertire
e e e E E Mac 'Caratteri sostitutivi
Fai in modo di allineare i caratteri da convertire con i caratteri sostitutivi, usando lo "spazio" per compensare (questa e' solo una convenienza per visualizzare allineate le sequenze, mentre quello che il codice considera e' la posizione ordinale del carattere/combinazione nella stringa).
Se scrivi le stringhe direttamente nell' editor delle macro non avrai difficolta' a garantire l' allineamento, altrimenti usa un font a larghezza fissa (tipo Courier); deve essere chiaro che la ChrConv sostituira' la prima sequenza della prima riga con la prima della seconda riga, la seconda con la seconda, e cosi' via.
La lunghezza delle sequenze possono essere diverse (infatti nell' esempio ho sostituito i due caratteri E' col carattere E, e lo scozzese Mc con l' inglese Mac). Infine la conversione e' "case sensitive", cioe' (vedi l' esempio di prima) McFarland diventera' MacFarland, ma MCFarland rimane inalterato; a scanso di equivoci devi quindi indicare tutte le combinazioni che prevedi di avere.
Le sequenze che si vogliono eliminare vanno inserite in coda nella prima stringa (se nella prima riga ci sono 20 combinazioni e nella seconda solo 17, le combinazioni 18/19/20 saranno cancellate e non sostituite).
Il nuovo codice per CommandButton1_Click ora e':
- Codice: Seleziona tutto
Private Sub CommandButton1_Click()
'vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=95607
'opzione ricerca per parola PIU' CONVERSIONE LETTERE
'
Dim I As Long
'
If myPrimo Is Nothing Then myCellFound = 0: Set myCorr = Nothing
'
RAvvia:
userform1.Caption = "CERCA in cella"
TextBox1.SetFocus
TextBox1.SelStart = 0
TextBox1.SelLength = Len(TextBox1.Text)
'
myArea = "AB3:AB100, A3:B2000"
If Not myCorr Is Nothing Then GoTo CkCmt
myFlag = 0
For Each myCell In ActiveSheet.Range(myArea)
If myCell.Value <> "" Then
If CheckBox2.Value And ComPar(ChrConv(myCell.Value), (TextBox1.Text)) Then myFlag = True
If CheckBox2.Value = False And Len(UCase(ChrConv(myCell.Value))) > Len(Replace(UCase(ChrConv(myCell.Value)), Trim(UCase(ChrConv(TextBox1.Text))), "")) Then myFlag = True
aaa = myCell.Value
If myFlag = True Then
CellFound = CellFound + 1
myFlag = 0
If CellFound > myCellFound Then
Set myPrimo = myCell: myK1 = 0
myCellFound = myCellFound + 1
userform1.Caption = "TROVATO in cella"
myCell.Select: Exit Sub
End If
End If
End If
Next myCell
GoTo CkCmt
'
CkCmt:
Set myCorr = ActiveCell
userform1.Caption = "CERCA in commento"
If myPrimo Is Nothing Then Set myPrimo = ActiveCell
If myCorr Is Nothing Then Set myCorr = Range("A1")
'myK1 = 0
For I = myK1 + 1 To ActiveSheet.Comments.Count
Set Kmt = ActiveSheet.Comments(I)
If Not Application.Intersect(Kmt.Parent, Range(myArea)) Is Nothing Then
myFlag = 0
If CheckBox2.Value = True And ComPar(ChrConv(Kmt.Text), ChrConv(TextBox1.Text)) Then myFlag = True
If CheckBox2.Value = False And Len(UCase(ChrConv(Kmt.Text))) > Len(Replace(UCase(ChrConv(Kmt.Text)), Trim(UCase(ChrConv(TextBox1.Text))), "")) Then myFlag = True
If myFlag = True Then
myK1 = I: Kmt.Parent.Select
userform1.Caption = "TROVATO in commento": Exit Sub
End If
End If
Next
'
FineKmt:
userform1.Caption = "------> FINE RICERCA"
Set myPrimo = Nothing ': GoTo RAvvia
End Sub
Mentre nel modulo dove hai gia' inserito Function splip e Function ComPar inserirai:
- Codice: Seleziona tutto
Function ChrConv(ByVal myStringa As String) As String
Dim myOld As String, myNew As String, myConvers As String, I As Long
'
myOld = "è e' é E' È Mc" '<< Le combinazioni da alterare
myNew = "e e e E E Mac" '<< Le combinazioni sostitutive
myConvers = myStringa
'
mySplitO = Split(Application.WorksheetFunction.Trim(myOld), " ")
mySplitN = Split(Application.WorksheetFunction.Trim(myNew), " ")
For I = LBound(mySplitO, 1) To UBound(mySplitO, 1)
If I <= UBound(mySplitN, 1) Then NewCh = mySplitN(I) Else NewCh = ""
myConvers = Replace(myConvers, mySplitO(I), NewCh)
Next I
ChrConv = myConvers
End Function
Le righe marcate << sono quelle da personalizzare seguendo le informazioi del testo.
Ciao