En relación al bucle que involucra meses
Buenas tardes, en días pasados recibí ayuda del experto Elsa Matilde, para destrabar un problemilla que tenía con un contador que involucra meses,
lo implementé pero no hace lo que debería hacer. El código de ese segmento quedó así:
'creamos una matriz con los nombres.... Completa hasta diciembre ... Listo
Dim MESES()
MESES = Array("enero", "febrero", "marzo", "abril", "mayo", "junio", "julio", "agosto", "septiembre", "octubre", "noviembre", "diciembre")
For nummes = 1 To 12 'ajustar a 12 ... Listo
mes = MESES(nummes - 1) 'se resta 1 porque la matriz empieza en 0
For renglon2 = 5 To 16
'inicia en d5 hasta d16
If Cells(renglon2, 4).Value = mes Then
'aquí el código de lo que debe ejecutarse al encontrar coincidencia
Sheets("consecutivo").Select
Range("A1").Select
ActiveCell.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
'FOLIO
Sheets("recibo").Select
Range("c4").Select
Selection.Copy
Sheets("consecutivo").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'DOMICILIO
ActiveCell.Offset(0, 1).Select
Sheets("recibo").Select
Range("B26").Select
Selection.Copy
Sheets("consecutivo").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'MES
ActiveCell.Offset(0, 1).Select
Sheets("recibo").Select
Range("D5").Select
Selection.Copy
Sheets("consecutivo").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'TOTAL
ActiveCell.Offset(0, 1).Select
Sheets("recibo").Select
Range("C15").Select
Selection.Copy
Sheets("consecutivo").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'CAJERO
ActiveCell.Offset(0, 1).Select
Sheets("recibo").Select
Range("C19").Select
Selection.Copy
Sheets("consecutivo").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'FECHA
ActiveCell.Offset(0, 1).Select
ActiveCell = Now()
Sheets("recibo").Select
End If
Next 'renglon2
Next 'nummes
End Sub
Y lo que debe hacer es copiar unas celdas de la hoja "recibo" a la hoja "consecutivo", si cierta celda en "recibo" (d5 a d16), tiene el valor de un mes
¿Puede decirme en donde está mal...? Por favor
José Manuel Sobrino
Le agradezco mucho
lo implementé pero no hace lo que debería hacer. El código de ese segmento quedó así:
'creamos una matriz con los nombres.... Completa hasta diciembre ... Listo
Dim MESES()
MESES = Array("enero", "febrero", "marzo", "abril", "mayo", "junio", "julio", "agosto", "septiembre", "octubre", "noviembre", "diciembre")
For nummes = 1 To 12 'ajustar a 12 ... Listo
mes = MESES(nummes - 1) 'se resta 1 porque la matriz empieza en 0
For renglon2 = 5 To 16
'inicia en d5 hasta d16
If Cells(renglon2, 4).Value = mes Then
'aquí el código de lo que debe ejecutarse al encontrar coincidencia
Sheets("consecutivo").Select
Range("A1").Select
ActiveCell.End(xlDown).Select
ActiveCell.Offset(1, 0).Select
'FOLIO
Sheets("recibo").Select
Range("c4").Select
Selection.Copy
Sheets("consecutivo").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'DOMICILIO
ActiveCell.Offset(0, 1).Select
Sheets("recibo").Select
Range("B26").Select
Selection.Copy
Sheets("consecutivo").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'MES
ActiveCell.Offset(0, 1).Select
Sheets("recibo").Select
Range("D5").Select
Selection.Copy
Sheets("consecutivo").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'TOTAL
ActiveCell.Offset(0, 1).Select
Sheets("recibo").Select
Range("C15").Select
Selection.Copy
Sheets("consecutivo").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'CAJERO
ActiveCell.Offset(0, 1).Select
Sheets("recibo").Select
Range("C19").Select
Selection.Copy
Sheets("consecutivo").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'FECHA
ActiveCell.Offset(0, 1).Select
ActiveCell = Now()
Sheets("recibo").Select
End If
Next 'renglon2
Next 'nummes
End Sub
Y lo que debe hacer es copiar unas celdas de la hoja "recibo" a la hoja "consecutivo", si cierta celda en "recibo" (d5 a d16), tiene el valor de un mes
¿Puede decirme en donde está mal...? Por favor
José Manuel Sobrino
Le agradezco mucho
1 respuesta
Respuesta de santiagomf
1
Te he revisado el código y, sobre todo, he cambiado muchas cosas. De todas formas creo que será más fácil de leer.
Por lo que veo copia una serie de celdas fijas (c4, b26, d5, etc...) a una página llamada 'consecutivo'.
No entiendo porqué buscas un nombre de mes en la columna "d" para luego copiar los datos de unas celdas fijas, pero supongo que es lo que quieres hacer.
Te dejo el código y si quieres vemos qué necesitas.
Un saludo
Sub comoSeLLameLaMacro()
Dim shR As Worksheet
Dim shC As Worksheet
Dim numMes As Integer
Dim mes As String
Dim renglon2 As Integer
Dim nLinC As Long
'creamos una matriz con los nombres... completa hasta diciembre ... listo
Dim MESES()
MESES = Array("enero", "febrero", "marzo", "abril", "mayo", "junio", "julio", "agosto", "septiembre", "octubre", "noviembre", "diciembre")
' Asignamos las páginas a una variable para no ir cambiando de un lado a otro
Set shR = Sheets("recibos")
Set shC = Sheets("consecutivos")
' Buscamos cada uno de los meses
For numMes = 1 To 12
mes = MESES(numMes - 1) 'se resta 1 porque la matriz empieza en 0
For renglon2 = 5 To 16
'inicia en d5 hasta d16
If UCase$(shR.Cells(renglon2, 4).Value) = UCase$(mes) Then ' Mejor comparamos todo en mayúsculas
'aquí el código de lo que debe ejecutarse al encontrar coincidencia
nLinC = shC.Columns(2).End(xlDown).Row + 1
shC.Cells(nLinC, 1) = shR.Range("c4") ' FOLIO
shC.Cells(nLinC, 2) = shR.Range("b26") 'DOMICILIO
shC.Cells(nLinC, 3) = shR.Range("d5") ' MES
shC.Cells(nLinC, 4) = shR.Range("c15") ' TOTAL
shC.Cells(nLinC, 5) = shR.Range("c19") ' CAJERO
shC.Cells(nLinC, 6) = Now() ' FECHA
End If
Next renglon2
Next numMes
Set shR = Nothing
Set shC = Nothing
End Sub
Por lo que veo copia una serie de celdas fijas (c4, b26, d5, etc...) a una página llamada 'consecutivo'.
No entiendo porqué buscas un nombre de mes en la columna "d" para luego copiar los datos de unas celdas fijas, pero supongo que es lo que quieres hacer.
Te dejo el código y si quieres vemos qué necesitas.
Un saludo
Sub comoSeLLameLaMacro()
Dim shR As Worksheet
Dim shC As Worksheet
Dim numMes As Integer
Dim mes As String
Dim renglon2 As Integer
Dim nLinC As Long
'creamos una matriz con los nombres... completa hasta diciembre ... listo
Dim MESES()
MESES = Array("enero", "febrero", "marzo", "abril", "mayo", "junio", "julio", "agosto", "septiembre", "octubre", "noviembre", "diciembre")
' Asignamos las páginas a una variable para no ir cambiando de un lado a otro
Set shR = Sheets("recibos")
Set shC = Sheets("consecutivos")
' Buscamos cada uno de los meses
For numMes = 1 To 12
mes = MESES(numMes - 1) 'se resta 1 porque la matriz empieza en 0
For renglon2 = 5 To 16
'inicia en d5 hasta d16
If UCase$(shR.Cells(renglon2, 4).Value) = UCase$(mes) Then ' Mejor comparamos todo en mayúsculas
'aquí el código de lo que debe ejecutarse al encontrar coincidencia
nLinC = shC.Columns(2).End(xlDown).Row + 1
shC.Cells(nLinC, 1) = shR.Range("c4") ' FOLIO
shC.Cells(nLinC, 2) = shR.Range("b26") 'DOMICILIO
shC.Cells(nLinC, 3) = shR.Range("d5") ' MES
shC.Cells(nLinC, 4) = shR.Range("c15") ' TOTAL
shC.Cells(nLinC, 5) = shR.Range("c19") ' CAJERO
shC.Cells(nLinC, 6) = Now() ' FECHA
End If
Next renglon2
Next numMes
Set shR = Nothing
Set shC = Nothing
End Sub
Maestro..!
Es más fácil de leer y de entender, resolviste magistralmente 2 problemas: redujiste el código considerablemente e hiciste funcionar el famoso " contador con meses", todo de manera excelente, lo cual te agradezco sobremanera ...
El hecho de evaluar la celda ("D5" a "D16") con meses, se debe a que va a tener un valor cambiante siempre, dependiendo de que mes se pagó y cuantos fueron, pueden ser de 1 a doce valores, de acuerdo a lo anterior, y como el problema pide que se registre cada pago realizado, el " contador con meses " era lo indicado, para no repetir el código por cada celda ("D5" a "D16")y por cada mes, espero haber explicado algo.
Finalmente agradezco muy fuertemente el tiempo dedicado a resolver este problema...
El todopoderoso te regresará mucho más...
Atentamente.
José Manuel Sobrino
p.d. solo modifiqué una pequeña línea:
shC.Cells(nLinC, 3) = shR.Cells(renglon2, 4) 'MES
Para que registrara en sheets(consecutivo) todos los meses pagados.
Y una última pregunta: que hace esto shC.Columns(2). End(xlDown). Row + 1
Más o menos, se que va al final de la hoja y busca la celda vacía, pero...
Gracias de nuevo...
Es más fácil de leer y de entender, resolviste magistralmente 2 problemas: redujiste el código considerablemente e hiciste funcionar el famoso " contador con meses", todo de manera excelente, lo cual te agradezco sobremanera ...
El hecho de evaluar la celda ("D5" a "D16") con meses, se debe a que va a tener un valor cambiante siempre, dependiendo de que mes se pagó y cuantos fueron, pueden ser de 1 a doce valores, de acuerdo a lo anterior, y como el problema pide que se registre cada pago realizado, el " contador con meses " era lo indicado, para no repetir el código por cada celda ("D5" a "D16")y por cada mes, espero haber explicado algo.
Finalmente agradezco muy fuertemente el tiempo dedicado a resolver este problema...
El todopoderoso te regresará mucho más...
Atentamente.
José Manuel Sobrino
p.d. solo modifiqué una pequeña línea:
shC.Cells(nLinC, 3) = shR.Cells(renglon2, 4) 'MES
Para que registrara en sheets(consecutivo) todos los meses pagados.
Y una última pregunta: que hace esto shC.Columns(2). End(xlDown). Row + 1
Más o menos, se que va al final de la hoja y busca la celda vacía, pero...
Gracias de nuevo...
