Saltar al contenido
Te enseño 7 de los trucos que me permitieron trabajar 2 horas menos al día >>>

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

paula.garcia87

Recommended Posts

paula.garcia87 Novato

paula.garcia87

publicado
publicado

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

Enlace a comentario
Compartir con otras webs
Antoni Mentor

Antoni

publicado
publicado

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]

Enlace a comentario
Compartir con otras webs
Antoni Mentor

Antoni

publicado
publicado

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.

.

Enlace a comentario
Compartir con otras webs
Antoni Mentor

Antoni

publicado
publicado

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]

Enlace a comentario
Compartir con otras webs
paula.garcia87 Novato

paula.garcia87

publicado
  • Autor
publicado

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

post-203762-145877016656_thumb.png

post-203762-145877016667_thumb.png

post-203762-145877016677_thumb.png

post-203762-145877016679_thumb.png

Enlace a comentario
Compartir con otras webs
Antoni Mentor

Antoni

publicado
publicado 
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]

Enlace a comentario
Compartir con otras webs
Antoni Mentor

Antoni

publicado
publicado

.

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.

.

Enlace a comentario
Compartir con otras webs
Antoni Mentor

Antoni

publicado
publicado

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]

Enlace a comentario
Compartir con otras webs
paula.garcia87 Novato

paula.garcia87

publicado
  • Autor
publicado

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]

Enlace a comentario
Compartir con otras webs
paula.garcia87 Novato

paula.garcia87

publicado
  • Autor
publicado

[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

Enlace a comentario
Compartir con otras webs

Archivado

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

Ir al listado de temas

  • 95 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • Sí
      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Mantenimiento de la comunidad
      Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR

  • Archivos

  • Estadísticas de descargas

    • Archivos
      177
    • Comentarios
      90
    • Revisiones
      27

  • Crear macros Excel

  • Mensajes

    • carlosleal23
      COMO ASIGNAR CADA DIA DE UN CALEDARIO A CADA HOJA

      Por carlosleal23 · publicado

      Muchas gracias me a servido de mucho su colaboaracion y ayuda.   Excelente aporte amigo.
    • jose_alk
      Registrar Progresos con valores repetidos y formula BuscarV

      Por jose_alk · publicado

      Gracias @Victor7. La solución que me das no es valida para mi proyecto ya que la idea es que en la pestaña DATAGlobal se vayan añadiendo registros, por lo que la formulas deben ser dinámicas en el sentido que según vaya añadiendo registros, se vayan completando el cuadro con los valores únicos.    Por otro lado, no puedo prescindir de la pestaña de valores únicos por que con esa información realizo otro tipo de informes con unidades totales, graficas con las fechas etc.. Muchas gracias por la ayuda
    • Antoni
      COMO ASIGNAR CADA DIA DE UN CALEDARIO A CADA HOJA

      Por Antoni · publicado

      Abre el adjunto y pulsa el botón  GENERAR HOJAS y luego pulsa sobre cualquier fecha del calendario para ir a la hoja deseada. Observa que he añadido 2 botones en la hoja CALENDARIO, uno para generar las hojas y otro para eliminarlas. También he añadido una flechita azul en las hojas generadas para volver a la hoja CALENDARIO. Estas son las macros: En la hoja CALENDARIO: Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim d As Integer, m As Integer, a As Integer On Error Resume Next If IsNumeric(Target) Then If Not Target = "" Then x = Int((Target.Row - 6) / 9) y = Int((Target.Column - 5) / 8) + 1 m = x * 6 + y d = Target a = Right([E3], 4) Sheets(Format(d, "00") & "-" & Format(m, "00") & "-" & a).Activate End If End If End Sub En el Módulo1: Sub GenerarHojas() Application.ScreenUpdating = False Application.CopyObjectsWithCells = True Dim a As Integer a = Right([E3], 4) With Sheets("ORIGI") For fecha = CDate("01/01/" & a) To CDate("31/12/" & a) '<-- Periodo a generar .Copy After:=Sheets(Sheets.Count) ActiveSheet.Name = Format(fecha, "dd-mm-yyyy") [B4] = [B4] & " " & fecha Next End With Volver End Sub '-- Sub EliminarHojas(): On Error Resume Next Application.ScreenUpdating = False Application.DisplayAlerts = False Dim a As Integer a = Right([E3], 4) For fecha = CDate("01/01/" & a) To CDate("31/12/" & a) '<-- Periodo a eliminar Sheets(Format(fecha, "dd-mm-yyyy")).Delete Next End Sub '-- Sub Volver() Sheets("CALENDARIO").Activate End Sub   Libro1 (15).xlsm
    • carlosleal23
      COMO ASIGNAR CADA DIA DE UN CALEDARIO A CADA HOJA

      Por carlosleal23 · publicado

      Hola un cordial saludo a todos.  Tengo una hoja con un formato de calendario y tengo 365 hojas cada una con nombre de un dia mes y año  en especifico agradecería me ayuden a como puedo realizar la vinculacion de cada dia del calendario con cada hoja respectivamente sin hacerlo de forma manual , ya que es muy laborioso dado que lo tengo que hacer de una por una.   adjunto coloco un ejemplo de lo que tengo gracias. Libro1.xlsm
    • jose_alk
      Registrar Progresos con valores repetidos y formula BuscarV

      Por jose_alk · publicado

      Muchas gracias @Israel Cassales. La hoja es un ejemplo de como seria la hoja definitiva. ( Por desgracia no puedo poner la información real). Los datos los saco de un registro automático por donde pasan unidades con un numero de referencia único para cada producto. Estas unidades pasan por unos puntos de control y en el registro automático se graban duplicando el numero de producto e indicando el registro del nuevo punto de control. Se que parece un poco lío explicado por aqui. Probaré la solución de @Victor7 y comentaré por aquí los progresos. Muchas gracias   

  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.