Macro buscar columna breve con palomeado

Datos con palomeado y datos sin palomeado

Caso dato buscado con palomeado:

(1) en celda busqueda digite "248" y di enter.

(2) Encuentra la columna llamada "PALOMEADO", y pregunta ¿escriba su palomeado? Respondí "A" (puede ser cualquier dato).

(3) Busca 1ra coincidencia, y pregunta ¿es el dato? (si o no).

(4) En caso error al digitar dato a buscar, quizás con "escape" o alguna otra tecla para que termine la búsqueda.

(5) Si 1ra coincidencia encontrada es correcta, doy "si", se colorea dicho dato y al costado derecho escribió "A" (celda "H5").

(6) La MACRO continua su búsqueda hasta terminar( fin1er caso)

2do CASO DATO SIN PALOMEADO:

Bueno este es el caso en que no puse al costado de la columna a buscar ningún encabezado con la palabra "PALOMEADO". Osea funciona como la MACRO original. Esta es la "MACRO ORIGINAL", ver link

MACRO realice búsqueda en donde se coloque la celda de "busqueda" (en 1ra fila)

Saludos, JOHNMOR41, LIMA PERÚ

1 respuesta

Respuesta
1

Te anexo macro actualizada

Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
    If Target.Address(False, False) = "G1" Then
        If Target.Count > 1 Then Exit Sub
        c = [F1]
        Set col = Cells.Find("PALOMEADO", lookat:=xlWhole)
        If Not col Is Nothing Then
            wcol = col.Column
            palo = InputBox("Escriba su palomeado")
        End If
        Set r = Range(c & "4:" & c & Range(c & Rows.Count).End(xlUp).Row)
        Set b = r.Find(Target, LookIn:=xlFormulas, lookat:=xlPart)
        r.Interior.ColorIndex = xlNone
        If Not b Is Nothing Then
            ncell = b.Address
            Do
                b.Select
                If MsgBox("Es el dato " & b.Value, vbQuestion + vbYesNo) = vbYes Then
                    b.Interior.ColorIndex = Target.Interior.ColorIndex
                    '
                    Cells(b.Row, wcol) = palo
                    If MsgBox("Desea continuar", vbQuestion + vbYesNo) = vbNo Then
                        Exit Sub
                    End If
                End If
                Set b = r.FindNext(b)
            Loop While Not b Is Nothing And b.Address <> ncell
            MsgBox "Ya no hay más coincidencias"
        Else
            MsgBox "No existen datos"
        End If
    End If
End Sub

Dante Amor, si esta funcionando para el 1er caso (cuando agrego la columna "PALOMEADO" pero no funciona para el 2do caso (cuando no tiene columna "PALOMEADO".

sobre poder "salir de la Macro a travez de una tecla" (punto (4)).

Creo que la alternativa mas logica es agregar una 3ra opcion de respuesta a las PREGUNTAS, de la siguiente forma:

¿ES EL DATO? alternativas de respuesta son [SI] o [NO] o [ESC]

1) [SI].- entonces colorea dato encontrado, escribe a su derecha la palabra o dato que se haya puesto para el "palomeo".

2) [NO].- entonces pregunta ¿DESEA CONTINUAR? respuestas alternativas son [SI] = busca siguiente coincidencia, o [NO] = continua a la otra coincidencia, o [ESC] = fin de Macro.

3) [ESC].- fin de Macro.

Osea en cada alternativa de respuesta me de la opcion [ESC] para poder finalizar la Macro

saludos, JOHNMMOR41

Macro actualizada

Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
    If Target.Address(False, False) = "G1" Then
        If Target.Count > 1 Then Exit Sub
        c = [F1]
        Set col = Cells.Find("PALOMEADO", lookat:=xlWhole)
        If Not col Is Nothing Then
            wcol = col.Column
            palo = InputBox("Escriba su palomeado")
        Else
            res = MsgBox("No está la columna palomeado, Continuar", vbQuestion + vbYesNo)
            If res = vbNo Then
                Exit Sub
            Else
                wcol = 0
            End If
        End If
        Set r = Range(c & "4:" & c & Range(c & Rows.Count).End(xlUp).Row)
        Set b = r.Find(Target, LookIn:=xlFormulas, lookat:=xlPart)
        r.Interior.ColorIndex = xlNone
        If Not b Is Nothing Then
            ncell = b.Address
            Do
                b.Select
                res = MsgBox("Es el dato " & b.Value, vbQuestion + vbYesNoCancel)
                Select Case res
                    Case vbYes
                        b.Interior.ColorIndex = Target.Interior.ColorIndex
                        If wcol <> 0 Then
                            Cells(b.Row, wcol) = palo
                        End If
                        If MsgBox("Desea continuar", vbQuestion + vbYesNo) = vbNo Then
                            Exit Sub
                        End If
                    Case vbNo
                        If MsgBox("Desea continuar", vbQuestion + vbYesNo) = vbNo Then
                            Exit Sub
                        End If
                    Case vbCancel
                        Exit Sub
                End Select
                Set b = r.FindNext(b)
            Loop While Not b Is Nothing And b.Address <> ncell
            MsgBox "Ya no hay más coincidencias"
        Else
            MsgBox "No existen datos"
        End If
    End If
End Sub

Saludos.Dante Amor

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas