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

paula.garcia87 · el 26 de enero

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

Antoni · el 26 de enero

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]

paula.garcia87 · el 26 de enero

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

Antoni · el 26 de enero

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.

.

paula.garcia87 · el 26 de enero

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

Antoni · el 26 de enero

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]

paula.garcia87 · el 27 de enero

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

aaquino · el 27 de enero

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.

paula.garcia87 · el 27 de enero

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?

Antoni · el 27 de enero

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]

Antoni · el 27 de enero

.

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.

.

paula.garcia87 · el 27 de enero

muchísimas gracias por tu ayuda Macro Antonio!

genial como siempre :-)

Antoni · el 27 de enero

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]

paula.garcia87 · el 27 de enero

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]

Antoni · el 27 de enero

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

Ejecuta la macro en este archivo.

Copia de ejemplo con diferentes hojas.zip

paula.garcia87 · el 28 de enero

[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