affiancare celledi 2 colonne con contenuto parzialmente uguale

Question

Buonasera,  non sono molto pratico e avrei bisogno di risolvere un problema con excel, ho due colonne:

                                                               colonna 1                                                   colonna 2

                                          www.miosito.it/collection/elena                 www.miosito.it/collection/nomi3/giacomo

                                          www.miosito.it/collection/maria                 www.miosito.it/collection/nomi1/giove

                                          www.miosito.it/collection/giacomo            www.miosito.it/collection/nomi2/venere

                                          www.miosito.it/collection/venere               www.miosito.it/collection/nomi3/elena

                                          www.miosito.it/collection/giove                 www.miosito.it/collection/nomi2/maria

la mia necessità sarebbe quella di confrontarli per il testo dopo l'ultimo "/" e affiancarli se il testo è uguale, in pratica confronterà "elena" della prima colonna e appena troverà "elena" nella seconda affiancherà le due celle, uguale per gli altri nomi," il risultato dovrà essere il seguente:

                                                               colonna 1                                                   colonna 2

                                          www.miosito.it/collection/elena                 www.miosito.it/collection/nomi3/elena

                                          www.miosito.it/collection/maria                 www.miosito.it/collection/nomi2/maria

                                          www.miosito.it/collection/giacomo            www.miosito.it/collection/nomi3/giacomo

                                          www.miosito.it/collection/venere               www.miosito.it/collection/nomi2/venere

                                          www.miosito.it/collection/giove                 www.miosito.it/collection/nomi1/giove

ovviamente i nomi per me sono molti e farlo manualmente richiederebbe parecchio tempo, spero di essermi spiegato bene, grazie in anticipo.

Answer 1

Ciao pacc88,

Benvenuto alla Community!

Buonasera,  non sono molto pratico e avrei bisogno di risolvere un problema con excel, ho due colonne:

                                                               colonna 1                                                   colonna 2

                                          www.miosito.it/collection/elena                 www.miosito.it/collection/nomi3/giacomo

                                          www.miosito.it/collection/maria                 www.miosito.it/collection/nomi1/giove

                                          www.miosito.it/collection/giacomo            www.miosito.it/collection/nomi2/venere

                                          www.miosito.it/collection/venere               www.miosito.it/collection/nomi3/elena

                                          www.miosito.it/collection/giove                 www.miosito.it/collection/nomi2/maria

la mia necessità sarebbe quella di confrontarli per il testo dopo l'ultimo "/" e affiancarli se il testo è uguale, in pratica confronterà "elena" della prima colonna e appena troverà "elena" nella seconda affiancherà le due celle, uguale per gli altri nomi," il risultato dovrà essere il seguente:

                                                               colonna 1                                                   colonna 2

                                          www.miosito.it/collection/elena                 www.miosito.it/collection/nomi3/elena

                                          www.miosito.it/collection/maria                 www.miosito.it/collection/nomi2/maria

                                          www.miosito.it/collection/giacomo            www.miosito.it/collection/nomi3/giacomo

                                          www.miosito.it/collection/venere               www.miosito.it/collection/nomi2/venere

                                          www.miosito.it/collection/giove                 www.miosito.it/collection/nomi1/giove

ovviamente i nomi per me sono molti e farlo manualmente richiederebbe parecchio tempo, spero di essermi spiegato bene, grazie in anticipo.

Prova qualcosa del genere:

• Alt+F11 per aprire l'editor di VBA
• Alt+IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

 '=========>>

Option Explicit

'--------->>

Public Sub Tester()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim Rng As Range, rCell As Range

    Dim arrIn As Variant, ArrOut() As Variant

    Dim aStr As String, bStr As String

    Dim sStr As String, tStr As String

    Dim LRow As Long, UB As Long

    Dim i As Long, j As Long

    Dim iPos As Long, jPos As Long

    Dim iCtr As Long, jCtr As Long

    Dim CalcMode As Long

    Const sMatched As String = "Matched"

    Const sFoglio As String = "Foglio1"

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    With SH

        LRow = LastRow(SH, .Columns("A:A"))

        Set Rng = .Range("A2:B" & LRow)

    End With

    arrIn = Rng.Value

    UB = UBound(arrIn)

    ReDim ArrOut(1 To 2, 1 To UB)

    For i = 1 To UB

        aStr = arrIn(i, 1)

        iPos = InStrRev(aStr, "/")

        sStr = Mid(aStr, iPos + 1)

        ArrOut(1, i) = aStr

        For j = 1 To UB

            bStr = arrIn(j, 2)

            jPos = InStrRev(bStr, "/")

            tStr = Mid(bStr, jPos + 1)

            If tStr = sStr Then

                ArrOut(2, i) = arrIn(j, 2)

                arrIn(j, 2) = sMatched

                iCtr = iCtr + 1

                Exit For

            End If

        Next j

    Next i

    If iCtr < UB Then

        For i = 1 To UB

            If arrIn(1, 2) <> sMatched Then

                jCtr = jCtr + 1

                ReDim Preserve ArrOut(1 To 2, 1 To UB + jCtr)

                ArrOut(2, UB + jCtr) = arrIn(i, 2)

            End If

        Next i

    End If

      With Application

        CalcMode = .Calculation

        .Calculation = xlCalculationManual

        .ScreenUpdating = False

    End With

    Rng.Offset(0, 3).Resize(UB + jCtr, 2).Value = _

                                    Application.Transpose(ArrOut)

XIT:

        With Application

            .Calculation = CalcMode

            .ScreenUpdating = True

        End With

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range, _

                        Optional minRow As Long = 1)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

    If LastRow < minRow Then

        LastRow = minRow

    End If

End Function

'<<========= 

• Alt+Q per chiudere l'editor di VBA e tornare a Excel
• Salva il file con l’estensione xlsm
• Alt+F8 per aprire  la finestra di gestione delle macro
• Seleziona Tester | Esegui

Potresti scaricare il mio file di prova  pacc20161124.xlsm a:

https://www.dropbox.com/s/8pg6rorbmskiqwh/pacc20161124.xlsm?dl=0

===

Regards,

Norman