Buscar palabras del texto de una celda en las columnas B, C y D de otra hoja del mismo libro y crear un useform.

Necesito hacer una búsqueda de cada palabra que forma parte de cada artículo de compra (Col. A, Hoja X) (quitando letras hasta 2) en las columnas B, C y D de cada fila de la hoja "P.G.C.", crear un listado de todas ellas guardando el número de fila. Si algún número de fila es única o se repite dos o más veces, esa es nuestra fila. En ese caso debería darlo de alta la macro en "ART_COMP." poniendo la "FAMILIA, DETALLE y SUBFAMILIA" de la fila encontrada sin más preámbulos, sin necesidad de aceptarlo tras comprobación. Ahora bien, si la búsqueda arroja más de una fila distinta con solo una coincidencia, o con dos o más coincidencias un userform para decidir cual escoger y enviarlo a "ART_COMP."

¿Podrían aparecer de color rojo aquellos que tienen coincidencia? Y para los que no tienen coincidencias ¿se podría presentar dentro del userform cuatro combobox (familia, detalle, subfamilia y descripción artículo en pgc) para elegirlos y dar de alta el "ART_COMP." desde ahí? En el cuarto combobox (descripción artículo en PGC) debería permitir escribir y dar de alta uno nuevo."

1 Respuesta

Respuesta
3

Va la macro de búsqueda

Private Sub ListBox1_Click()
'Busca coincidencias
    If cargando Then Exit Sub
    ListBox2.RowSource = ""
    h4.Rows("2:" & Rows.Count).Clear
    fila = Buscar_Coincidencias(ListBox1.List(ListBox1.ListIndex, 0), 2)
    If fila = 1 Then
        h4.Cells.EntireColumn.AutoFit
        u4 = h4.Range("A" & Rows.Count).End(xlUp).Row
        col = "I"
        For i = 1 To Columns(col).Column
            anch = anch & Int(h4.Cells(1, i).Width) + 3 & ";"
        Next
        ListBox2.ColumnWidths = anch
        ListBox2.RowSource = h4.Name & "!" & h4.Range("A2:" & col & u4).Address
    Else
        MsgBox "No hay coincidencias", vbExclamation, "COINCIDENCIAS"
    End If
End Sub
'
Function Buscar_Coincidencias(articulo, op)
'Función para buscar coincidencias
    If cargando Then Exit Function
    Set r = h3.Columns("B:D")
    arts = Split(articulo, " ")
    j = 2
    n = 0
    salir = False
    For k = LBound(arts) To UBound(arts)
        p = 1
        art = WorksheetFunction.Trim(arts(k))
        Select Case LCase(art)
            Case "de", "del", "", "-", " ", ".", ",", ";"
            Case Else
                If n = 2 Then
                    'salir = True
                    Exit For
                End If
                n = n + 1
                yaexiste = False
                For m = Len(art) To 2 Step -1
                    ya_encontro = False
                    Set b = r.Find(art, lookat:=xlPart)
                    If Not b Is Nothing Then
                        ya_encontro = True 'ya encontro en pgc y ya no quita letras
                        If op = 2 Then
                            celda = b.Address
                            wfila = 0
                            Do
                                'detalle
                                If b.Row <> wfila Then
                                    For q = 2 To h4.Range("A" & Rows.Count).End(xlUp).Row
                                        If h4.Cells(q, "J") = b.Row Then
                                            yaexiste = True 'ya exite en temp ya no registra
                                            Exit For
                                        End If
                                    Next
                                    If yaexiste = False Then
                                        h3.Rows(b.Row).Copy h4.Rows(j)
                                        h4.Cells(j, "J") = b.Row
                                        j = j + 1
                                    End If
                                    yaexiste = False
                                End If
                                wfila = b.Row
                                Set b = r.FindNext(b)
                            Loop While Not b Is Nothing And b.Address <> celda
                        End If
                        '
                        Buscar_Coincidencias = 1
                        If op = 1 Then
                            salir = True
                            Exit For
                        End If
                        If ya_encontro Then
                            Exit For
                        End If
                    End If
                    If p = 3 Then
                        Exit For
                    End If
                    p = p + 1
                    art = Left(art, Len(art) - 1)
                Next
                If salir Then
                    Exit For
                End If
            'end case
        End Select
    Next
End Function
'
Private Sub UserForm_Activate()
'Analiza artículos
    Set h1 = Sheets("Revision de articulos")
    Set h2 = Sheets("ART_COMP.")
    Set h3 = Sheets("P.G.C.")
    Set h4 = Sheets("Temp")
    Set h5 = Sheets("Temp1")
    '
    h4.Rows("2:" & Rows.Count).Clear
    h5.Rows("2:" & Rows.Count).Clear
    j = 2
    For i = 2 To h1.Range("A" & Rows.Count).End(xlUp).Row ' Step -1
        art = h1.Cells(i, "A")
        Set b = h2.Columns("A").Find(art, lookat:=xlWhole)
        If b Is Nothing Then
            'si no encuentra, lo agrega al list para clasificar
            h5.Cells(j, "A") = art
            If Buscar_Coincidencias(art, 1) <> 1 Then
                h5.Cells(j, "B") = "x"
            End If
            j = j + 1
        End If
    Next
    u5 = h5.Range("A" & Rows.Count).End(xlUp).Row
    rango = h5.Range("A2:B" & u5).Address
    h5.Cells.EntireColumn.AutoFit
    col = "B"
    For i = 1 To Columns(col).Column
        anch = anch & Int(h5.Cells(1, i).Width) + 3 & ";"
    Next
    ListBox1.RowSource = h5.Name & "!" & rango
    ListBox1.ColumnWidths = anch
End Sub

sal u dos

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas