[VBA macro] Problema con .Find

[romeombo]

Ciao a tutti,
ho un problema con la ricerca in un foglio excel attraverso una macro.
Mi spiego meglio :

Ho 2 campi, colonne (A,B)
La colonna A possiede 332 righe
La colonna B possiede 895 righe

Voglio, attraverso macro, per tutti i valori contenuti nella colonna A cercare tutte quelle righe di B che contengono un valore simile ad A e posizionare i vari valori trovati in una terza colonna, la C separati dal carattere ; punto e virgola.

Ad esempio

A                   B                         C
pippo                pippo_1                pippo_1;pippo_2;pippo_3
paperino             pippo_2                paperino_1;paperino_2;paperino_3;
pluto                pippo_3                pluto_1;pluto_2
                     paperino_1
                     paperino_2
                     paperino_3                     
                     pluto_1
                     pluto_2

ovvero nella colonna B , il valore pippo di A occorre 3 volte e quindi tutte e tre le occorrenze dovrebbero apparire in C seguita da un punto e virgola.
Stessa cosa per paperino etc....

A tale scopo ho scritto questa macro :

Public Function FindAllStrings(ByVal strSearchString As String)
    With ActiveSheet.Range("B1:B895")
       Set c = .Find(strSearchString, LookIn:=xlValues)
       If Not c Is Nothing Then
        Valore = c.Value
        first = c.Address
        firstRow = c.Row
        firstCol = c.Column
            Do
                Valore = Valore & ";" & c.Value
                Set c = .FindNext(c)
            Loop While c Is Nothing And c.Address <> first
             ActiveSheet.Cells(firstRow, firstCol + 1).Value = Valore
        End If
    End With
End Function
Sub Trova_e_Copia()
'
' Trova_e_Copia Macro
'
For i = 1 To 332
    FindAllStrings (Range("A" & i).Value)
Next i
End Sub

Il problema è che eseguendola non mi trova tutti i campi ma solo alcuni di essi a volte raddoppiandoli. ad esempio in C avrò qualcosa tipo

C
pippo_2;pippo_2
paperino_1;paperino_1;
pluto_1;pluto_2

Stranezza è che provando con una cosa simile

With ActiveSheet.Range("B1:B895")
       Set c = .Find("pippo", LookIn:=xlValues)
       MsgBox(c.Value)
End With

appare il messaggio con pippo_2 e non con pippo_1.
Invece se eseguo una ricerca tradizionale usando lo strumento messo a disposizione da Excel stesso, nessun problema, find mi trova la prima occorrenza, usando next passa alla seconda occorrenza, usando next all'eventuale terza occorrenza, senza problemi
mi vien da pensare che non funzioni a dovere la funzione .find
Grazie

[MarcoGG]

Originariamente inviato da romeombo

Ciao a tutti,
ho un problema con la ricerca in un foglio excel attraverso una macro.
Mi spiego meglio :

Ho 2 campi, colonne (A,B)
La colonna A possiede 332 righe
La colonna B possiede 895 righe

Voglio, attraverso macro, per tutti i valori contenuti nella colonna A cercare tutte quelle righe di B che contengono un valore simile ad A e posizionare i vari valori trovati in una terza colonna, la C separati dal carattere ; punto e virgola.

Ad esempio

A                   B                         C
pippo                pippo_1                pippo_1;pippo_2;pippo_3
paperino             pippo_2                paperino_1;paperino_2;paperino_3;
pluto                pippo_3                pluto_1;pluto_2
                     paperino_1
                     paperino_2
                     paperino_3                     
                     pluto_1
                     pluto_2

ovvero nella colonna B , il valore pippo di A occorre 3 volte e quindi tutte e tre le occorrenze dovrebbero apparire in C seguita da un punto e virgola.
Stessa cosa per paperino etc....

    Dim a As Long
    a = 1
    Dim b As Long
    b = 1
    Dim c As Long
    c = 1
    Dim s As String
    Do
        If Range("A" & a).Text = "" Then Exit Do
        s = ""
        b = 1
        Do
            If Range("B" & b).Text = "" Then Exit Do
            If Not Range("B" & b).Find(Range("A" & a).Text) Is Nothing Then
                s = s & Range("B" & b).Text & ";"
            End If
            b = b + 1
        Loop
        If s <> "" Then
            Range("C" & c).FormulaR1C1 = s
            c = c + 1
        End If
        a = a + 1
    Loop