Detectar rango!
Hola!
Mi duda es: tengo dos columnas (código repuesto/descripción)
Código repuesto Descripción
---------------------------------------------------
121 Motorreductor 1
121 15Hp
121 Marca: Sew
---------------------------------------------------
122 Motorreductor 2
122 Marca: Sew
...
La descripción puede ocupar uno, dos, tres o cuatro renglones, y el código se repite hasta que termina la descripción de ese repuesto.
Lo que quiero es una macro para que haga un recuadro alrededor de la información de cada código y que detecte el rango automáticamente teniendo en cuenta que empieza y termina con el mismo valor (que no tenga que ir seleccionando yo el rango). }
Muchas Gracias! Celeste
Mi duda es: tengo dos columnas (código repuesto/descripción)
Código repuesto Descripción
---------------------------------------------------
121 Motorreductor 1
121 15Hp
121 Marca: Sew
---------------------------------------------------
122 Motorreductor 2
122 Marca: Sew
...
La descripción puede ocupar uno, dos, tres o cuatro renglones, y el código se repite hasta que termina la descripción de ese repuesto.
Lo que quiero es una macro para que haga un recuadro alrededor de la información de cada código y que detecte el rango automáticamente teniendo en cuenta que empieza y termina con el mismo valor (que no tenga que ir seleccionando yo el rango). }
Muchas Gracias! Celeste
1 Respuesta
Respuesta de angelcrisnor
1
Creo que esta macro de más abajo te debería servir para lo que pides, dediendo cambiar tan solo lo que está en negrita.
Saludos
Angel
+++++++++++++++++++++++++++++++++++++++++++++++++++++
Sub EncuadraCodigos()
'
FILA_INICIAL = 3
COLUMNA_INICIAL = "B"
COLUMNA_FINAL = "C"
'
FilaOrigen = FILA_INICIAL
ClaveActual = Range(COLUMNA_INICIAL + Trim(Str(FilaOrigen)))
'
Do While ClaveActual <> ""
FilaFinal = FilaOrigen
Do While Range(COLUMNA_INICIAL + Trim(Str(FilaFinal + 1))) = ClaveActual
FilaFinal = FilaFinal + 1
Loop
'
Rango = COLUMNA_INICIAL + Trim(Str(FilaOrigen)) + ".." + COLUMNA_FINAL + Trim(Str(FilaFinal))
Range(Rango).Select
'Con el rango ya seleccionado hacemos lo que corresponda...
'INICIO DEL TRATAMIENTO DEL RANGO ----------------
With Selection
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
'
FilaOrigen = FilaFinal + 1
'
ClaveActual = Range(COLUMNA_INICIAL + Trim(Str(FilaOrigen)))
'
Loop
'
Range("A1").Select
'
End Sub
Saludos
Angel
+++++++++++++++++++++++++++++++++++++++++++++++++++++
Sub EncuadraCodigos()
'
FILA_INICIAL = 3
COLUMNA_INICIAL = "B"
COLUMNA_FINAL = "C"
'
FilaOrigen = FILA_INICIAL
ClaveActual = Range(COLUMNA_INICIAL + Trim(Str(FilaOrigen)))
'
Do While ClaveActual <> ""
FilaFinal = FilaOrigen
Do While Range(COLUMNA_INICIAL + Trim(Str(FilaFinal + 1))) = ClaveActual
FilaFinal = FilaFinal + 1
Loop
'
Rango = COLUMNA_INICIAL + Trim(Str(FilaOrigen)) + ".." + COLUMNA_FINAL + Trim(Str(FilaFinal))
Range(Rango).Select
'Con el rango ya seleccionado hacemos lo que corresponda...
'INICIO DEL TRATAMIENTO DEL RANGO ----------------
With Selection
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
'
FilaOrigen = FilaFinal + 1
'
ClaveActual = Range(COLUMNA_INICIAL + Trim(Str(FilaOrigen)))
'
Loop
'
Range("A1").Select
'
End Sub
