Asignar variables a muchas celdas de una columna
Espero poder explicarme, necesito que de una lista de 500 celdas de la columna "M", (M1 a M500) en una macro yo pueda realizar el siguiente proceso
Dim crit1 As String
crit1 = range("M1").Value
If range("M1").Value = 0 Then
ActiveCell.Offset(1, 0).Select
Else
ActiveCell.Offset(2, 0).Select
End Ifpero sin necesidad de escribir 500 veces el código.
1 respuesta
Dim crit1 As String
crit1 = range("K1").Value
If range("K1").Value = 0 Then
ActiveCell.Offset(1, 0).Select
Else
range("A3:A5000").Select
Selection.Find(What:=[crit1], After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Selection.FindNext(After:=ActiveCell).Activate
ActiveCell.Offset(0, 2).Select
range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 1)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.End(xlToLeft).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "0"
ActiveCell.Offset(-1, 1).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End IfBásicamente si la celda asignada a la variable tiene cero, continua con el análisis de la segunda celda de lo contrario se desplaza a la columna "A" avanza hacia la izquierda e inserta una celda para poner un "cero" pero lo que me interesa es únicamente simplificar el no tener que declara 500 variables.
Detallando esto es lo que deseo hacer, tengo en la columna "M1" a la "M500" una lista de valores de los cuales los primeros valores son claves o códigos y después celdas con "0" y lo que hace este código anexado es valorar si la celda "M1" contiene un valor mayor a cero, si no es así, simplemente baja una celda y vuelve a realizar el análisis, si por el contrario es un valor mayor a "0" entonces se traslada a la columna "A" y la recorre de "A1" a "A500" esperando encontrar el valor que fue mayor a "0" guardado en la variable "Crit1", una ves encontrado, realiza lo indicado en "else", (recorrerse dos lineas a la izquierda, insertando una linea y copiando valores), lo que deseo es que este proceso no lo tenga que indicar 500 veces, simplemente declarar las 500 variables "Crit." de una forma práctica y de acuerdo al rango "K" y aparte realizar las validaciones de "If" otras 500 veces también de acuerdo al rango "K".
Dim crit1 As String
crit1 = range("M1").Value
If range("M1").Value = 0 Then
ActiveCell.Offset(1, 0).Select
Else
range("A3:A5000").Select
Selection.Find(What:=[crit1], After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Selection.FindNext(After:=ActiveCell).Activate
ActiveCell.Offset(0, 2).Select
range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 1)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.End(xlToLeft).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "0"
ActiveCell.Offset(-1, 1).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Dim crit2 As String
crit2 = range("M2").Value
If range("M2").Value = 0 Then
ActiveCell.Offset(1, 0).Select
Else
range("A3:A5000").Select
Selection.Find(What:=[crit2], After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlColumns, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
Selection.FindNext(After:=ActiveCell).Activate
ActiveCell.Offset(0, 2).Select
range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, 1)).Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.End(xlToLeft).Select
ActiveCell.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "0"
ActiveCell.Offset(-1, 1).Select
Selection.Copy
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
Ok
A ver si entendí y por lo que veo
1 - buscar el valor de la POR del rango M1:M500 en el range A
2 - si lo encuentra insertar una celda C y D
3 - en esa celda nueva copiar el valor buscado
4 - este valor a buscar puede aparecer varias veces osea si lo encuentra en una celda tiene que seguir con la búsqueda y si lo encuentra de Nuevo hacer la operación
Hay lgo que no entiendo en tu expl;icacion como vas inserta a la izquierda si esta en la columna A
Sorry quise decir a la derecha pero ese básicamente es el problema, no realizar este proceso de escritura 5400 veces
Estas dos soluciones a ver cual te gusta más
1 - primera solución
uso de for next
For i = 1 To 500
If Cells(i, "M") > 0 Then
If Cells(i, "M") = "" Then Exit Sub
Set h = Sheets("Diaria")
Set b = h.Columns("b").Find(Cells(i, "M"))
b.Offset(0, 2) = b
End If
Next
esto intruciones dice que la I sera la variable crit que usaremos
For i = 2 To 500 declaramos las variables del la fila 1 hasta la 500 y la llamamos "I"
If Cells(i, "M") > 0 Then si la fila X es mayor a "0" entonces has estos que esta debajo
Set h = Sheets("Diaria") la hoja la llamaremos 'H' y diario es el nombre de tu hoja
Set b = h.Columns("A").Find(Cells(i, "M")) aqui creamos la busqueda en toda la columna A y la llamamos B
aqui pones lo que quiere que haga si encuentra el valor a buscar
en mi ejemplo b.Offset(0, 2) = b le dije que dos columna a la derecha copie el valor buscado
End If cerramos el si
next para que repita el proceso hasta la fila 500
2 - segunda opcion
Do While
Range("m1").Select
Do While ActiveCell <> ""
If ActiveCell > "0" Then
Set h = Sheets("Diaria")
Set b = h.Columns("b").Find(ActiveCell)
b.Offset(0, 2) = b
End If
ActiveCell.Offset(1, 0).Select
Loop
esta intriciones nos dice .......
Range("m1").Select selecionamos donde vamos a empesar
Do While ActiveCell <> "" si la celda activa no esta vacia has lo siguiente
If ActiveCell > "0" Then si celda activa es mayor que 0 entonces has lo siguiente
Set h = Sheets("Diaria") la hoja la llamaremos 'H' y diario es el nombre de tu hoja
Set b = h.Columns("b").Find(ActiveCell) aqui creamos la busqueda en toda la columna A y la llamamos B
aqui pones lo que quiere que haga si encuentra el valor a buscar
en mi ejemplo b.Offset(0, 2) = b le dije que dos columna a la derecha copie el valor buscado
End If cerramos el si
ActiveCell.Offset(1, 0).Select aqui le digo cambia la celda activa a la siguiente
loop para que vuelva al primer paso al if
Si te silve no olvides valora para cerrar la pregunta
