"resize" de una fórmula hasta la ultima fila con datos

publicado el 26 de enero9 años

Hola a todos,

tengo una macro que me busca una celda con una texto concreto, me crea una columna justo después y la rellena con una fórmula. Todo funciona, pero quiero que la fórmula la rellena solo hasta la última celda con datos de la columna vecina. Ahora tengo puesto que me copie la fórmula hasta la fila 6000.

Selection.AutoFill Destination:=Selection.Resize(6000, 1)

P.D: mi pregunta de hoy es más concreta y espero que sencilla :-)

Muchas gracias de antemano!

Paula

RESIZE ejemplo.zip

publicado el 26 de enero9 años

Prueba a ver que tal va.

Sub Column_NT()

Dim D As Range, Columna As Integer

Application.ScreenUpdating = False

Sheets("Soll Modelle").Select

For Each D In Range("A1:AR7").Cells

   If D = "*P-Teile" Then

      Columna = D.Column + 1

      Columns(Columna).Insert

      Cells(1, Columna) = "Normteile"

      Cells(2, Columna).FormulaR1C1 = _

          "=IF(OR(LEFT(RC[-8],4)=""WHT."",LEFT(RC[-8],4)=""N  .""),""X"","""")"

      Cells(2, Columna).Copy _

          Range(Cells(3, Columna), Cells(Range("A1").End(xlDown).Row, Columna))

   End If

Next

End Sub

[/CODE]

publicado el 26 de enero9 años

Autor

Hola Macro Antonio,

me ha funcionado de lujo!

si ese mismo código se lo quiero aplicar a las diferentes hojas de un mismo libro de excel?

Solo cambiaría el nombre de la hoja.

Te envio el archivo con todas las hojas adjuntas.

ejemplo con diferentes hojas.zip

publicado el 26 de enero9 años

Selecciona cualquier hoja y ejecuta la macro.

Vale para cualquier hoja y cualquier número de filas y columnas.

Sub Column_NT()

Dim D As Range, Columna As Integer

Application.ScreenUpdating = False

Set D = Rows(1).Find("*P-Teile")

If Not D Is Nothing And _

   Not D.Offset(0, 1) = "Normteile" Then

   Columna = D.Column + 1

   Columns(Columna).Insert

   Columns(Columna).NumberFormat = "General"

   Cells(1, Columna) = "Normteile"

   Cells(2, Columna).FormulaR1C1 = _

       "=IF(OR(LEFT(RC[-8],4)=""WHT."",LEFT(RC[-8],4)=""N  .""),""X"","""")"

   Cells(2, Columna).Copy _

       Range(Cells(3, Columna), Cells(Range("A1").End(xlDown).Row, Columna))

End If

End Sub

[/CODE]

Si te interesa, te puedo adaptar la macro para que actúe en todas las hojas de una vez.

publicado el 26 de enero9 años

Autor

La verdad que una única macro que lo hago en todas las hojas de una vez suena bien :-)

publicado el 26 de enero9 años

Creo que es esto:

Sub Column_NT_All()

Dim D As Range, Columna As Integer, H As Worksheet

'-----------------------------------------------------

Const Buscar As String = "*P-Teile"  'Columna a buscar

Const Añadir As String = "Normteile" 'Columna a añadir

'-----------------------------------------------------

Application.ScreenUpdating = False

For Each H In Sheets

   Set D = H.Rows(1).Find(Buscar)

   If Not D Is Nothing And _

      Not D.Offset(0, 1) = Añadir Then

      Columna = D.Column + 1

      H.Columns(Columna).Insert

      H.Columns(Columna).NumberFormat = "General"

      H.Cells(1, Columna) = Añadir

      H.Cells(2, Columna).FormulaR1C1 = _

          "=IF(OR(LEFT(RC[-8],4)=""WHT."",LEFT(RC[-8],4)=""N  .""),""X"","""")"

      H.Cells(2, Columna).Copy _

          H.Range(H.Cells(3, Columna), H.Cells(H.Range("A1").End(xlDown).Row, Columna))

   End If

Next

End Sub

[/CODE]

publicado el 27 de enero9 años

Autor

Hola macro Antonio!

utilizo esta macro integrada en más código, y con tu ejemplo para aplicar la macro a más páginas de una vez, me da error...

Si lo personalizo para que actue en cada una de la hojas:

Dim D As Range, Columna As Integer

Application.ScreenUpdating = False

Sheets("Soll Modelle").Select

For Each D In Range("A1:AR7").Cells

   If D = "*P-Teile" Then

      Columna = D.Column + 1

      Columns(Columna).Insert

      Cells(1, Columna) = "Normteile"

      Cells(2, Columna).FormulaR1C1 = _

          "=IF(OR(LEFT(RC[-8],4)=""WHT."",LEFT(RC[-8],4)=""N  .""),""X"","""")"

      Cells(2, Columna).Copy _

          Range(Cells(3, Columna), Cells(Range("A1").End(xlDown).Row, Columna))

   End If

Next



Sheets("Fehlteile").Select

For Each D In Range("A1:AR7").Cells

   If D = "*P-Teile" Then

      Columna = D.Column + 1

      Columns(Columna).Insert

      Cells(1, Columna) = "Normteile"

      Cells(2, Columna).FormulaR1C1 = _

          "=IF(OR(LEFT(RC[-8],4)=""WHT."",LEFT(RC[-8],4)=""N  .""),""X"","""")"

      Cells(2, Columna).Copy _

          Range(Cells(3, Columna), Cells(Range("A1").End(xlDown).Row, Columna))

   End If

Next[/CODE]

Me funciona en la primera hoja y luego la fórmula se copia asi: "=IF(OR(LEFT(RC[-8],4)="WHT.",LEFT(RC[-8],4)="N ."),"X","")". Y no se reconoce la fórmula...

Muchas gracias de antemano!

Paula

publicado el 27 de enero9 años

Creo que para corregir la fórmula es tan simple como saber un poco de inglés:

IF = SI

OR = O

AND = Y

LEFT = IZQUIERDA

Prueba modificando estas palabras en la fórmula y nos comentas.

publicado el 27 de enero9 años

Autor

no no, ese no es el problema, de todas maneras yo lo tengo en alemán XD.

El problema es RC[-8], como traduzco eso de VBA a fórmulas de excel?

publicado el 27 de enero9 años

Sub Column_NT_All()

Dim D As Range, Columna As Integer, H As Worksheet

'-----------------------------------------------------

Const Buscar As String = "*P-Teile"  'Columna a buscar

Const Añadir As String = "Normteile" 'Columna a añadir

'-----------------------------------------------------

Application.ScreenUpdating = False

For Each H In Sheets

   Set D = H.Rows(1).Find(Buscar)

   If Not D Is Nothing Then

      If Not D.Offset(0, 1) = Añadir Then

         Columna = D.Column + 1

         H.Columns(Columna).Insert

         H.Columns(Columna).NumberFormat = "General"

         H.Cells(1, Columna) = Añadir

         H.Cells(2, Columna).FormulaR1C1 = _

             "=IF(OR(LEFT(RC[-8],4)=""WHT."",LEFT(RC[-8],4)=""N  .""),""X"","""")"

         H.Cells(2, Columna).Copy _

             H.Range(H.Cells(3, Columna), H.Cells(H.Range("A1").End(xlDown).Row, Columna))

      End If

   End If

Next

End Sub[/CODE]

publicado el 27 de enero9 años

Por partes, el error es culpa mía, y se producía cuando había una hoja sin la columna "*P-Teile".

En cuanto al problema de la fórmula, se arregla convirtiendo el formato de las celdas a "General" .

Las fórmulas en la macro están en formato R1C1, esto significa que todos los rangos están refererenciados en relación a la celda que contiene la fórmula, así, si pones en la celda H1 la formula =RC[-8] estás nombrado a la celda 8 columnas a la izquierda de la celda H1, es decir, la celda A1. En definitiva H1=RC[-8] es lo mismo que H1=A1.

A raíz de lo expuesto, me acabo de dar cuenta que la macro está rematadamente mal ya que la fórmula solo vale para la hoja "Soll Modelle".

Corrijo y la subo de nuevo.

publicado el 27 de enero9 años

Autor

muchísimas gracias por tu ayuda Macro Antonio!

genial como siempre :-)

publicado el 27 de enero9 años

Ahora creo que si está OK.

Sub Column_NT_AllOk()

Dim D As Range, Columna As Integer

Dim H As Worksheet, Gap As Integer

'-----------------------------------------------------

Const Buscar As String = "*P-Teile"  'Columna a buscar

Const Añadir As String = "Normteile" 'Columna a añadir

Const SachnummerPS As Integer = 4    'Columna de Sachnummer PS

'-----------------------------------------------------

Application.ScreenUpdating = False

For Each H In Sheets

   Set D = H.Rows(1).Find(Buscar)

   If Not D Is Nothing Then

      If Not D.Offset(0, 1) = Añadir Then

         Columna = D.Column + 1

         Gap = SachnummerPS - Columna

         H.Columns(Columna).Insert

         H.Columns(Columna).NumberFormat = "General"

         H.Cells(1, Columna) = Añadir

         H.Cells(2, Columna).FormulaR1C1 = _

             "=IF(OR(LEFT(RC[" & Gap & "],4)=""WHT."",LEFT(RC[" & Gap & "],4)=""N  .""),""X"","""")"

         H.Cells(2, Columna).Copy _

             H.Range(H.Cells(3, Columna), H.Cells(H.Range("A1").End(xlDown).Row, Columna))

      End If

   End If

Next

End Sub

[/CODE]

publicado el 27 de enero9 años

Autor

Con este código no me da ningún error, pero no me crea la columna...

Sin embargo el primer código que me escribiste sí funciona aunque solo sea en la hoja "Soll Modelle" Las hojas son 4 y siempre se llaman igual. Habría una manera de adpatar la macro a ellas para q funciona como el primer código?

Dim D As Range, Columna As Integer

Application.ScreenUpdating = False

Sheets("Soll Modelle").Select

For Each D In Range("A1:AR7").Cells

   If D = "*P-Teile" Then

      Columna = D.Column + 1

      Columns(Columna).Insert

      Cells(1, Columna) = "Normteile"

      Cells(2, Columna).FormulaR1C1 = _

          "=IF(OR(LEFT(RC[-8],4)=""WHT."",LEFT(RC[-8],4)=""N  .""),""X"","""")"

      Cells(2, Columna).Copy _

          Range(Cells(3, Columna), Cells(Range("A1").End(xlDown).Row, Columna))

   End If

NextDim D As Range, Columna As Integer

Application.ScreenUpdating = False

Sheets("Soll Modelle").Select

For Each D In Range("A1:AR7").Cells

   If D = "*P-Teile" Then

      Columna = D.Column + 1

      Columns(Columna).Insert

      Cells(1, Columna) = "Normteile"

      Cells(2, Columna).FormulaR1C1 = _

          "=IF(OR(LEFT(RC[-8],4)=""WHT."",LEFT(RC[-8],4)=""N  .""),""X"","""")"

      Cells(2, Columna).Copy _

          Range(Cells(3, Columna), Cells(Range("A1").End(xlDown).Row, Columna))

   End If

Next[/CODE]

publicado el 27 de enero9 años

Algo debes estar haciendo mal, a mi me funciona perfectamente.

Ejecuta la macro en este archivo.

Copia de ejemplo con diferentes hojas.zip

publicado el 28 de enero9 años

Autor

[uSER=46507]@Macro Antonio[/uSER]. El problema está en el código con el que combino esta macro. Ese código también me crea columnas y colisiona de alguna manera con esta última versión de la macro. Sin embargo con las versión original, la primera que me enviaste funciona de lujo y no hay colisiones en los códigos

Sub Column_NT()

Dim D As Range, Columna As Integer

Application.ScreenUpdating = False

Sheets("Soll Modelle").Select

For Each D In Range("A1:AR7").Cells

If D = "*P-Teile" Then

Columna = D.Column + 1

Columns(Columna).Insert

Cells(1, Columna) = "Normteile"

Cells(2, Columna).FormulaR1C1 = _

"=IF(OR(LEFT(RC[-8],4)=""WHT."",LEFT(RC[-8],4)=""N .""),""X"","""")"

Cells(2, Columna).Copy _

Range(Cells(3, Columna), Cells(Range("A1").End(xlDown).Row, Columna))

End If

Next

End Sub

Adjunto te envio el código completo. Añado esa parte justo al final del módulo que se llama "Verbauungsmatrix" (te he comentado en el código a aprtir de cuando quiero añadir el código). Te envio también un ejemplo de archivo de entrada con el que usar la macro. Espero que puedas ayudarme. Y muchísimas gracias por todo de antemano!

Un saludo

Paula

ejemplo con resto del código.zip

archivo de entrada.zip

publicado el 4 de febrero9 años

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Ir al listado de temas

Domina Excel, de Cero a Experto

¿Atascado? Deja de buscar soluciones puntuales. Aprende a dominar Excel para siempre con nuestro curso online. Más de 115 lecciones y soporte directo.

Ver el Curso Completo

193 Archivos
99 Comentarios
30 Revisiones
Última descarga

Agenda Calendario Vintage
- 2

Fechas Móviles

Saludos adjunto el archivo con cinco ejemplos distintos con los respectivos resultados esperados para el mes de octubre de 2025 y 2026:
Primer Viernes de Octubre 03/10/2025 - 02/10/2026
Segundo Jueves de Octubre 09/10/2025 - 08/10/2026
Tercer Miércoles de Octubre 15/10/2025 - 14/10/2026
Tercer Martes de Octubre 21/10/2025 - 20/10/2026
Cuarto Lunes de Octubre 27/10/2025 - 26/10/2026
En cuanto a la forma de calcular estas son las formulas utilizadas en el video para el tercer Viernes de Agosto de 2021:
Primero se calcula el primer día del mes:
FECHANUMERO("01/"&S7&R7)

Luego se calcula que día de la semana cae el primer día del mes:
DIASEM(B5;2)
Luego se resta el numero del día que corresponde al Viernes (5) menos el numero del día que corresponde primer día del mes (Domingo (7))
X7-7

Si el resultado anterior es ≥ 0 entonces se resta los días hábiles existentes entre el primer día del mes y el día anterior a la fecha buscada en caso contrario se suma el total de días hábiles en el mes
SI(S14>=0;Y7+S14;Z7+S14)

Por ultimo al resultado anterior se le suma la fecha inicial y se obtiene la fecha y correspondiente al día buscado;
SI(S14>=0;Y7+S14;Z7+S14)+T7
Feriados Moviles (B).xlsx

Por jues, · publicado el viernes a las 20:071 día
Fechas Móviles

...la tabla no queda bien...
Adjunto archivo.
Feriados Moviles (B).xlsx

Por Victor7, · publicado el martes a las 19:454 días
Fechas Móviles

Lo siento, pero voy a repetirme sobre lo que dije en mi anterior intervención: "Sería interesante que explicaras con detalle qué es lo que falla de tu archivo, por qué, y qué es lo que buscas obtener".
A ver si así avanzamos: Supongamos que tienes esta tabla:
Inicial
Final
Inicial
Final
Ajuste
Dia Habil
Habiles
Habiles
Año
2025
2026
01/10/2025
31/10/2025
01/10/2026
31/10/2026
5
5
23
23

01/10/2025
31/10/2025
01/10/2026
31/10/2026
3
4
23
23

01/10/2025
31/10/2025
01/10/2026
31/10/2026
2
7
23
23

01/10/2025
31/10/2025
01/10/2026
31/10/2026
7
3
23
23

¿Qué 4 fechas concretas deberían aparecer en cada una de las 2 últimas columnas?
¿Cómo se llega a ellas? ¿Qué cálculos son necesarios?

Por Victor7, · publicado el martes a las 19:394 días
Fechas Móviles

Saludos Sr @Victor7
Con este cuadro lo que pretendo es poder obtener cualquier fecha móvil existente en el calendario festivo y que la misma se actualice de manera automática en las Celdas AB y AC sin la necesidad de hacer ajustes posteriores de allí que tome las formulas que se muestran en el tutorial y las fui anidando de forma tal que pudiera obtener el mismo resultado del ejemplo por lo cual es conveniente indicar que de acuerdo al ejemplo del tutorial:
Celda X: Aquí se introduce manualmente el número del día de la semana donde se ubica la fecha móvil buscada
Celda Y: Aquí se introduce manualmente la cantidad de días hábiles existentes antes de la fecha móvil buscada
Celdas Z y AA: Muestra la cantidad de días hábiles existentes en el mes de la fecha móvil
Celdas AB y AC: Arrojan la fecha móvil exacta conforme al año y los datos introducidos en las Celdas X y Y
Haciendo un análisis de los datos infiero que el problema radica en que el ejemplo del tutorial está configurado para arrojar resultados correctos solamente para la semana que contenga el tercer viernes de un mes determinado de allí que al buscar otra fecha móvil los datos que se introducen en las Celdas X y Y no sean no sean los que realmente deberían para que se puedan alcanzar las fechas exactas en las Celdas AB y AC, sin embargo hay fechas que aun introduciendo datos correctos en las Celdas X y Y o aproximándolos lo más posible no es posible obtener resultados correctos.

Por jues, · publicado el martes a las 15:014 días
Fechas Móviles

Hola,
Sería interesante que explicaras con detalle qué es lo que falla de tu archivo, por qué, y qué es lo que buscas obtener.
Hasta la columna W todo parece entendible, pero habría que ver cómo los datos X:Y introducidos a voluntad (supongo), afectan al comportamiento (o no) de los siguientes cálculos. Igual que las columnas AB:AC, qué resultados pretenden plasmar.
Saludos,

Por Victor7, · publicado el martes a las 06:555 días

No hay usuarios registrado para ver esta página.

Conéctate a Ayuda Excel

"resize" de una fórmula hasta la ultima fila con datos

Featured Replies

Archivado

Archivos

Agenda Calendario Vintage

Cómo conservar la función AHORA()

Agenda v01

Gráficos de aranceles con colores difusos

Cómo crear hipervínculos inteligentes con fórmulas

Estadísticas de descargas

Mensajes

Fechas Móviles

Fechas Móviles

Fechas Móviles

Fechas Móviles

Fechas Móviles

Visualizado recientemente 0

Account

Navigation

Buscar

Configure browser push notifications

Chrome (Android)

Chrome (Desktop)

Safari (iOS 16.4+)

Safari (macOS)

Edge (Android)

Edge (Desktop)

Firefox (Android)

Firefox (Desktop)