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
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 SubSaludos.Dante Amor
