Comparar Celdas!!

HOLA HECTOR!!
Excelte macro me sirvio mucho, le hize una pequeña modificacion, que cuando
no haya clave no me sacará mensaje, por que las claves no vienen en todas las
lineas, simplemente le agregue un case que no me hiciera nada:
Case ""
Select Case Range("t1")
End Select.
Te pregunto: se puede hacer que una clave marque dos celdas, aveces nos
llegan en parejas ejemplo: ING-RET, VSP-VST
los estuve probando pero no me dio.

MUCHAS GRACIAS POR TODA TU AYUDA
SALUDOS!!!

hol, Danilo !

... se puede hacer que una clave marque dos celdas
... a veces nos llegan en parejas ejemplo: ING-RET, VSP-VST [...]

siempre y cuando las claves 'vengan completas' [3 literales en cada 'separacion']
podras 'atender' a mas de dos ;)
[ya lo habia 'adelgazado'... pero apareciendo cosas que se habian quedado en el tintero]
-> la estructuracion del codigo es diferente

si cualquier duda... comentas?
saludos,
hector.
en un modulo de codigo 'normal' ==Sub PonerClave(): Application.ScreenUpdating = False
Dim Claves, Celda As Range, Clave As Integer, Preguntar As Boolean, _
Filas As Long, Fila As Long, Varios As Byte, Desde As Byte, Hasta As Byte
Claves = Array("vac", "lma", "ige", "sln", "vst", "vsp", "taa", "tda", "ret", "ing")
For Each Celda In Selection: Celda.Offset(, -11).Resize(, 10).ClearContents
Preguntar = True: Clave = EstaClave(LCase(Celda), Claves)
If Clave <> -1 Then Celda.Offset(, -Clave - 2) = "X": Preguntar = False
If Preguntar Then
With ActiveWindow
Fila = Celda.Row: Filas = .VisibleRange.Rows.Count + .VisibleRange.Row - 1
If Fila > Filas Then .ScrollRow = .VisibleRange.Row + (Fila - Filas): Application.ScreenUpdating = True
End With: Application.ScreenUpdating = False
Varios = Len(Celda) - Len(Application.Substitute(Celda, "-", "")) + 1
If Varios > 1 Then
Desde = 1
For Sig = 1 To Varios
If Sig < Varios Then Hasta = InStr(Desde, Celda, "-") - 1
Clave = EstaClave(LCase(Trim(Mid(Celda, Desde, 3))), Claves)
If Clave <> -1 Then Celda.Offset(, -Clave - 2) = "X"
Desde = Hasta + 2
Next
Else
Select Case LCase(Celda)
Case ""
Case "i": Corrige Celda, "ING", "IGE", "SIN Marca", 11, 4
Case "t": Corrige Celda, "TDA", "TAA", "SIN Marca", 9, 8
Case "v": Corrige Celda, "VSP", "VST", "Siguiente...", 7, 6
Case Else: MsgBox "Clave NO 'reconocida' !!!", vbCritical, Celda.Address
End Select
End If
End If
Next
End Sub
Private Function EstaClave(ByVal Clave As String, Claves) As Integer: Dim Sig As Byte: EstaClave = -1
For Sig = LBound(Claves) To UBound(Claves)
If Clave = Claves(Sig) Then EstaClave = Sig: Exit For
Next
End Function
Private Sub Corrige(ByVal Celda As Range, _
ByVal Op1 As String, ByVal Op2 As String, ByVal Op3 As String, _
ByVal Col1 As Byte, ByVal Col2 As Byte)
Select Case MsgBox("Selecciona la opción apropiada..." & vbCr & _
"SI = " & Op1 & vbCr & "NO = " & Op2 & vbCr & "Cancelar = " & Op3, _
vbYesNoCancel + vbQuestion, "Corregir " & Celda.Address)
Case vbYes: Celda.Offset(, -Col1) = "X": Case vbNo: Celda.Offset(, -Col2) = "X"
Case vbCancel
If Op3 = "Siguiente..." Then
If MsgBox("¿Deseas marcarla como ""VAC""?", _
vbYesNo + vbQuestion, "Corregir " & Celda.Address) = vbYes _
Then Celda.Offset(, -2) = "X"
End If: End Select
End Sub

Hola Hector!!
Muchas Gracias por la macro, tengo dos preguntas:
-Como puedo poner mas claves, en el codigo anterior lo hize:
Clave = Array("Ing", "Ingreso", "Inicio", "Inicia", "Ret", "R", "retiro",
"retirado", "retirada", "Tda", "Taa", "Vsp", "Vps", "Vst", "Vts", "Sln",
"Ige", "Lma", "Vac")
Desplaza = Array(-11, -11, -11, -11, -10, -10, -10, -10, -10, -9, -8, -7,
-7, -6, -6, -5, -4, -3, -2)
Estas son la mayoria de claves (novedades) que nos llegan, en el ultimo
codigo que me mandaste no supe como hacerlo...

-La otra pregunta es si se puede que cuando este marcando la "X" no vaya
bajando linea por linea si no que nada mas muestre la linea cuando las claves
llegen como "i", "t", "v", y no reconocidas, esto lo digo por que es un poco
mas lento si va bajando linea por linea.

Muchas gracias Hector por tu ayuda.

saludos!!!!

Hola Hector!!
Disculpa la segunda pregunta es que cuando hayan celdas vacias no me mustre
esa linea, que nada mas me la muestre cuando vengan marcadas como "i",
"t","v", por que lo que estoy haciendo es que antes de empezar la macro le
pongo:
Range("T1:T1000").Select
para que na haya que seleccionar manualmente, entoces si vienen por ejemplo
claves hasta la linea 200 de hay hasta la 1000 empieza a bajar una por una y
esto me quita mucho tiempo.

Gracias Hector!!!

Hola Hector!!
Disculpa la segunda pregunta es que cuando hayan celdas vacias no me mustre
esa linea, que nada mas me la muestre cuando vengan marcadas como "i",
"t","v", por que lo que estoy haciendo es que antes de empezar la macro le
pongo:
Range("T1:T1000").Select
para que na haya que seleccionar manualmente, entoces si vienen por ejemplo
claves hasta la linea 200 de hay hasta la 1000 empieza a bajar una por una y
esto me quita mucho tiempo.

Gracias Hector!!!






"Héctor Miguel" escribió:

hol, Danilo !

> ... se puede hacer que una clave marque dos celdas
> ... a veces nos llegan en parejas ejemplo: ING-RET, VSP-VST [...]

siempre y cuando las claves 'vengan completas' [3 literales en cada 'separacion']
podras 'atender' a mas de dos ;)
[ya lo habia 'adelgazado'... pero apareciendo cosas que se habian quedado en el tintero]
-> la estructuracion del codigo es diferente

si cualquier duda... comentas?
saludos,
hector.
en un modulo de codigo 'normal' ==> Sub PonerClave(): Application.ScreenUpdating = False
Dim Claves, Celda As Range, Clave As Integer, Preguntar As Boolean, _
Filas As Long, Fila As Long, Varios As Byte, Desde As Byte, Hasta As Byte
Claves = Array("vac", "lma", "ige", "sln", "vst", "vsp", "taa", "tda", "ret", "ing")
For Each Celda In Selection: Celda.Offset(, -11).Resize(, 10).ClearContents
Preguntar = True: Clave = EstaClave(LCase(Celda), Claves)
If Clave <> -1 Then Celda.Offset(, -Clave - 2) = "X": Preguntar = False
If Preguntar Then
With ActiveWindow
Fila = Celda.Row: Filas = .VisibleRange.Rows.Count + .VisibleRange.Row - 1
If Fila > Filas Then .ScrollRow = .VisibleRange.Row + (Fila - Filas): Application.ScreenUpdating = True
End With: Application.ScreenUpdating = False
Varios = Len(Celda) - Len(Application.Substitute(Celda, "-", "")) + 1
If Varios > 1 Then
Desde = 1
For Sig = 1 To Varios
If Sig < Varios Then Hasta = InStr(Desde, Celda, "-") - 1
Clave = EstaClave(LCase(Trim(Mid(Celda, Desde, 3))), Claves)
If Clave <> -1 Then Celda.Offset(, -Clave - 2) = "X"
Desde = Hasta + 2
Next
Else
Select Case LCase(Celda)
Case ""
Case "i": Corrige Celda, "ING", "IGE", "SIN Marca", 11, 4
Case "t": Corrige Celda, "TDA", "TAA", "SIN Marca", 9, 8
Case "v": Corrige Celda, "VSP", "VST", "Siguiente...", 7, 6
Case Else: MsgBox "Clave NO 'reconocida' !!!", vbCritical, Celda.Address
End Select
End If
End If
Next
End Sub
Private Function EstaClave(ByVal Clave As String, Claves) As Integer: Dim Sig As Byte: EstaClave = -1
For Sig = LBound(Claves) To UBound(Claves)
If Clave = Claves(Sig) Then EstaClave = Sig: Exit For
Next
End Function
Private Sub Corrige(ByVal Celda As Range, _
ByVal Op1 As String, ByVal Op2 As String, ByVal Op3 As String, _
ByVal Col1 As Byte, ByVal Col2 As Byte)
Select Case MsgBox("Selecciona la opción apropiada..." & vbCr & _
"SI = " & Op1 & vbCr & "NO = " & Op2 & vbCr & "Cancelar = " & Op3, _
vbYesNoCancel + vbQuestion, "Corregir " & Celda.Address)
Case vbYes: Celda.Offset(, -Col1) = "X": Case vbNo: Celda.Offset(, -Col2) = "X"
Case vbCancel
If Op3 = "Siguiente..." Then
If MsgBox("¿Deseas marcarla como ""VAC""?", _
vbYesNo + vbQuestion, "Corregir " & Celda.Address) = vbYes _
Then Celda.Offset(, -2) = "X"
End If: End Select
End Sub