- 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
'CheckBox3 per eventuale riepilogo su Form2; vedi modifiche marcate >>
'
Dim I As Long
'>>
NextUB = UBound(myListREs, 2) + 1
ReDim Preserve myListREs(1 To 5, 1 To NextUB)
'
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
'>>
If Me.CheckBox3 = True Then CompilaLR1 (Selection.Row)
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"
'>>
If Me.CheckBox3 = True Then CompilaLR1 (Selection.Row)
Exit Sub
End If
End If
Next
'
FineKmt:
userform1.Caption = "------> FINE RICERCA"
'>>
If myListI > 0 Then
ReDim Preserve myListREs(1 To 5, 1 To myListI)
UserForm2.Show
End If
Set myPrimo = Nothing ': GoTo RAvvia
End Sub
il codice lo modificato come sopra..forse sbaglio..