Ricercare valore preciso

Hai un problema con Excel?

Nuova discussione

Ricercare valore preciso
di Davide (utente non iscritto) data: 10/04/2015 12:42:51
Buongiorno, scusate ho un problema.
faccio una ricerca in un range nel seguente modo

il problema è che mi trova celle che oltre ad avere il valore ricercato ad es. PIPPO mi trova anche ad es. PIPPO2
come si può' fare
With my_range_2 For Each Cella_1 In my_range_3 Set range_a = .Find(what:=Cella_1, LookIn:=xlValues) If Not range_a Is Nothing Then
di alfrimpa data: 10/04/2015 13:44:37
Ciao

Prova a mettere nel Find il parametro LookAt:=xlWhole

Alfredo
di davide (utente non iscritto) data: 10/04/2015 13:53:44
Grazie
di Davide (utente non iscritto) data: 10/04/2015 17:29:04
Altra domanda
Se un range è costituito da celle uguale è possibile fare in modo di ricercare con il .find tutte quelle celle (a differenza del cerca verticale che restituisce la prima)?
di alfrimpa data: 10/04/2015 17:53:24
Ciao

Ora sono fuori per cui non ho il pc ma dovresti vedere un po' il metodo FindNext

Alfredo

di Davide (utente non iscritto) data: 10/04/2015 22:46:48
Riporto il ciclo come fatto sino ad ora senza il finnext.
Dovrei invece ricercare la Cella_1 in tutto il range my_range_2 (anche quelli successivi al primo) e poi scrivere in

wbk_1.Sheets("Generale").Cells(Cella.Row, range_b_column) = la somma di tutte le Cella_2

Sub Estrazione_generale()

Dim sws As String
Dim ws As Worksheet
Dim sWsName As String



Dim wbk_1 As Workbook

Dim fso As Object

Dim my_range_1 As Range
Dim my_range_2 As Range
Dim my_range_3 As Range


Dim range_a As Range
Dim range_a_row As Integer
Dim range_a_column As Integer


Dim range_b_row As Integer
Dim range_b_column As Integer

Dim Cella As Range
Dim Cella_1 As Range
Dim Cella_2 As Double
Dim Cella_3 As String

Dim wSheet As Worksheet

Set wbk_1 = ThisWorkbook

Set fso = CreateObject("Scripting.FileSystemObject")
Set my_range_1 = wbk_1.Sheets("Generale").Range("B4:B20000").SpecialCells(xlCellTypeConstants)
Set my_range_3 = wbk_1.Sheets("Generale").Range("d2:BBB2").SpecialCells(xlCellTypeConstants)


For Each ws In wbk_1.Worksheets
    sws = sws & "#" & ws.Name
Next
  sws = sws & "#"
  

For Each Cella In my_range_1
    sWsName = Trim(Cella.Value)
    If InStr(1, sws, "#" & sWsName & "#", vbTextCompare) > 0 Then
      Set my_range_2 = wbk_1.Sheets(sWsName).Range("d16:d20000")
   

        'Set my_range_2 = wbk_1.Sheets(Trim(Cella)).Range("d16:d2000").SpecialCells(xlCellTypeConstants)

        With my_range_2
        For Each Cella_1 In my_range_3
           Set range_a = .Find(what:=Cella_1, LookIn:=xlValues, LookAt:=xlWhole)
    
            If Not range_a Is Nothing Then
                range_a_row = range_a.Row
                range_a_column = range_a.Column
                range_b_row = Cella_1.Row
                range_b_column = Cella_1.Column
                Cella_2 = wbk_1.Sheets(Trim(Cella)).Range("h" & range_a_row)
                wbk_1.Sheets("Generale").Cells(Cella.Row, range_b_column) = Cella_2
                
                
            
            
            
            End If
        Next
        End With
    End If
'End If

Next

End Sub

di Davide (utente non iscritto) data: 12/04/2015 12:40:46
Ho apportare alcune modifiche per fare il "findnext". Ho pero' il problema che una volta trovata la cella deve fare la somma dei contenuti. La somma la effettua ma il valore che mi fornisce è sempre il doppio rispetto a quello che dovrei ottenere. Non capisco dove sbaglio.

Sub Estrazione_generale()

Dim sws As String
Dim ws As Worksheet
Dim sWsName As String



Dim wbk_1 As Workbook

Dim fso As Object

Dim my_range_1 As Range
Dim my_range_2 As Range
Dim my_range_3 As Range


Dim range_a As Range
Dim range_a_row As Integer
Dim range_a_column As Integer

Dim first As String


Dim range_b_row As Integer
Dim range_b_column As Integer

Dim Cella As Range
Dim Cella_1 As Range
Dim Cella_2 As Double
Dim Cella_3 As Double
Dim Cella_4 As Double

Dim wSheet As Worksheet

Set wbk_1 = ThisWorkbook

Cella_4 = 0

Set fso = CreateObject("Scripting.FileSystemObject")
Set my_range_1 = wbk_1.Sheets("Generale").Range("B4:B20000").SpecialCells(xlCellTypeConstants)
Set my_range_3 = wbk_1.Sheets("Generale").Range("d2:BBB2").SpecialCells(xlCellTypeConstants)


For Each ws In wbk_1.Worksheets
    sws = sws & "#" & ws.Name
Next
  sws = sws & "#"
  

For Each Cella In my_range_1
    sWsName = Trim(Cella.Value)
    If InStr(1, sws, "#" & sWsName & "#", vbTextCompare) > 0 Then
      Set my_range_2 = wbk_1.Sheets(sWsName).Range("d16:d1000")
   

        
        With my_range_2
        For Each Cella_1 In my_range_3
           Set range_a = .Find(what:=Cella_1, LookIn:=xlValues, LookAt:=xlWhole)
            Cella_2 = 0
            Cella_3 = 0
            Cella_4 = 0
    
            If Not range_a Is Nothing Then
                range_a_row = range_a.Row
                range_a_column = range_a.Column
                range_b_row = Cella_1.Row
                range_b_column = Cella_1.Column
                Cella_2 = wbk_1.Sheets(Trim(Cella)).Range("h" & range_a_row)
                first = range_a.Address
                
                'wbk_1.Sheets("Generale").Cells(Cella.Row, range_b_column) = Cella_2
                
                Do
                Set range_a = .FindNext(After:=range_a)
                    If Not range_a Is Nothing Then
                        range_a_row = range_a.Row
                        range_a_column = range_a.Column
                        range_b_row = Cella_1.Row
                        range_b_column = Cella_1.Column
                        Cella_3 = wbk_1.Sheets(Trim(Cella)).Range("h" & range_a_row)
                        Cella_4 = Cella_3 + Cella_4
                    End If
                     Loop While Not range_a Is Nothing And range_a.Address <> first
                     
                   wbk_1.Sheets("Generale").Cells(Cella.Row, Cella_1.Column) = Cella_2 + Cella_4
            End If
               
        Next
        End With
    End If
'End If

Next

End Sub

Vuoi Approfondire?