Jump to content

Combinar matrices o rangos


Recommended Posts

Hola,

Tengo la necesidad de combinar los registros de una matriz (las filas) creando una nueva matriz en otra hoja con el doble de campos (las columnas originales y las resultante de la combinación) de forma que cada registro original se combine con todos los subsiguientes de la matriz. Como ejemplo, si tengo una matriz de 3 campos y 5 registros como la que pongo acontinuación:

C-1 C-2 C-3
A B C
D E F
G H I
J K L
M N O

 

Necesito una fórmula de excel o una macro que me dé como resultado una matriz o una tabla con 6 campos y 10 registros en este caso particular:

C-1 C-2 C-3 C-1 C-2 C-3
A B C D E F
A B C G H I
A B C J K L
A B C M N O
D E F G H I
D E F J K L
D E F M N O
G H I J K L
G H I M N O
J K L M N O

 

El número de filas (registros) y columnas (campos) de la matriz/tabla original cambiarían de una vez a otra. Lo ideal sería que la tabla original estuviera en una hoja y la nueva tabla resultado de la combinación se creara en una nueva hora.

No sé si hay alguna fórmula de excel para realizar esta actividad o si alguien en el foro ha colgado una macro que realize esta tarea o similar y que me pueda servir.

Gracias por la ayuda y cometarios que me podáis hacer.

Un saludo

 

 

 

 

 

     
     
     
     
     
     
Link to comment
Share on other sites

Soy incapaz de descifrar el patrón que tiene el rango...

Pienso que lo mejor para descifrar este reto es usar Power Query, pues tiene mucha más potencia para transformar los datos.

¿Puedes dar más detalle sobre el patrón?

Link to comment
Share on other sites

Sub Combinar()
Application.ScreenUpdating = False
columnas = Cells(1, 1).End(xlToRight).Column
For Z = 1 To Range("A" & Rows.Count).End(xlUp).Row
   For x = Z + 1 To Range("A" & Rows.Count).End(xlUp).Row
      fila = fila + 1
      Range("A" & Z).Resize(1, columnas).Copy Cells(fila, columnas + 2)
      Range("A" & x).Resize(1, columnas).Copy Cells(fila, columnas * 2 + 2)
   Next
Next
End Sub

Vale para cualquier dimensión de la matriz.

La duración de la macro es exponencial respecto al número de filas.

Link to comment
Share on other sites

Hola Sergio,

Perdona pero parece que no me he explicado suficientemente bien.

En el ejemplo que pongo, la matriz original tiene 3 campos (C-1, C-2 y C-3) y 5 registros. Y lo que necesito es una fórmula o macro  que genere una nueva matriz con el doble de columnas (dos veces los campos originales: C-1, C-2, C-3 C-1, C-2, C-3, puesto de forma consecutiva) y que los registros sean una combinación del primero con el segundo ABCDEF, el primero con el tercero ABCGHI, el primero con el cuarto ABCJLK, y así hasta el último registro de la matriz original, y después una combianción del segundo registro con el tercero DEFGHI, el segundo con el cuarto DEFJLK, y así sucesivamente hasta llegar al penultimo regístro que se combinaría con el último para dar lugar a JLKMNO. Creo que ahora se entiende mejor el ejemplo que puse para intentar explicar lo que necesitaba. Pero para un caso más "real" necesitaría que funcionará para más de 3 campos y más de 5 registros, aunque la cantidad de campos y registros puede variar de una ocasión a otra.

Gracias por tu interés en mi problema.

Link to comment
Share on other sites

hace 11 horas, Antoni dijo:
Sub Combinar()
Application.ScreenUpdating = False
columnas = Cells(1, 1).End(xlToRight).Column
For Z = 1 To Range("A" & Rows.Count).End(xlUp).Row
   For x = Z + 1 To Range("A" & Rows.Count).End(xlUp).Row
      fila = fila + 1
      Range("A" & Z).Resize(1, columnas).Copy Cells(fila, columnas + 2)
      Range("A" & x).Resize(1, columnas).Copy Cells(fila, columnas * 2 + 2)
   Next
Next
End Sub

Vale para cualquier dimensión de la matriz.

La duración de la macro es exponencial respecto al número de filas.

Hola Antoni,

Gracias por el programa que has escrito,  estos días lo pruebo y te digo si me ha funcionado, aunque suponco que lo habrás testado cuando lo has desarrollado.

Supongo que lo único que lo único que tendré que hacer es copiarlo y pegarlo para que funcione (lo pregunto porque no controlo mucho sobre las macros y esto tiene pinta de macro)

Muchas gracias.

Edited by eljadi
Link to comment
Share on other sites

Hola Antoni,

Después de varios intentos para conseguir correr la macro, no sé por qué me daba problemas, la he corrido y funciona bien. Tan solo que la primera fila del rango, donde están los títulos de los campos también se combinan, por lo que tengo que quitarlos a mano posteriormente, ¿se puede hacer una modificación de algunos de los parámetros para que no se incluya los títulos de los campos en la combinatoria del rango? y por otra parte se ¿pueden copiar el nombre de las columnas del rango como encabezado del nuevo rango?. Con un rango de 3 columnas y 4 filas se hace a mano en un plis-plas, pero con decenas de columnas y filas ya es más rollo. Por otra parte ¿es difícil que el nuevo rango se cree en otra hoja del libro en lugar de en la misma hoja? para así evitar tener que copiarlo en otra hoja para trabajar con los nuevos datos.

Abajo incluyo un pantallazo de correr la macro con un rango de 3 columnas y 5 filas.

Muchas gracias por todo Antoni.

Lo que me has enviado me viene muy bien. Si no es difícil ni te lleva mucho tiempo realizar las modificaciones que te comento te agradecería que en un huequito que tengas libre las desarrollaras, así sería mucho más fácil para mí utilizarla.

Gracias de nuevo.

image.thumb.png.771ea0c73d532fffeb6e260d9a43af89.png 

Link to comment
Share on other sites

Debes tener una hoja con el nombre Resultado, si la quieres cambiar, modifica la línea resaltada en la macro.

Colócate en la hoja donde tienes los datos a combinar antes de ejecutar la macro, 

Sub Combinar()
Application.ScreenUpdating = False

'------------------------------------------------------------
With Sheets("Resultado") '<-- Nombre de la hoja del resultado
'------------------------------------------------------------

   columnas = Cells(1, 1).End(xlToRight).Column
   .Cells.Clear
   Cells(1, 1).Resize(1, columnas).Copy .Cells(1, 1)
   Cells(1, 1).Resize(1, columnas).Copy .Cells(1, columnas + 1)
   fila = 1
   For Z = 2 To Range("A" & Rows.Count).End(xlUp).Row
      For x = Z + 1 To Range("A" & Rows.Count).End(xlUp).Row
         fila = fila + 1
         Range("A" & Z).Resize(1, columnas).Copy .Cells(fila, 1)
         Range("A" & x).Resize(1, columnas).Copy .Cells(fila, columnas + 1)
      Next
   Next
   .Select
End With
Application.StatusBar = False
End Sub

 

Edited by Antoni
Link to comment
Share on other sites

Hola Antoni,

Eres un crack!! Funciona super bien el programa que has escrito. Muchas gracias.

Por cierto conoces  y me podría recomendar algún tutorial web o en youtube para aprender un poco sobre macros en excel, ya que me incluso cortar y pegar me da algunos problemas y tengo que eliminar o cambiar sobre una macro grabada con la grabadora. Es para saber lo que "estoy haciendo".  Algo que sea didáctico desde cero.

También podría ser para libreoffice Calc, ya que lo tengo en otro ordenador.

Gracias de nuevo por tu tiempo y dedicación.

Un saludo

 

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
  • 28 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

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


      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR
  • Files

  • Download Statistics

    • Files
      150
    • Comments
      87
    • Reviews
      25

  • Crear macros Excel

  • Posts

    • Equipo buenas noches, espero esten bien. Soy nuevo en este mundo del vba de excel. En sintesis mi proyecto es crear estados de cuenta para clientes, para ello disene en excel un estado de cuenta, ahora toca salvar en pdf, esa parte esta lista para un solo documento, pero tengo un data validation list con todos mis clientes, la idea es que se cree un loop que vaya nombre por nombre de la lista y me salve un pdf por cada cliente en una ruta previamente definida. les dejo el codigo que tengo hasta el momento para ver si me pueden ayudar:   Option Explicit Sub GuardarEstado()     Dim nombredearchivo As String     Dim NombreHoja As String     Dim HojaDestino As Range     Dim NuevaFila As Integer     Dim i As Integer     Dim j As Integer     Dim NumFactura As String     Dim Ruta As String     Dim dataValidationCell As Range     Dim dataValidationListSource As Range     Dim dvValueCell As Range     Dim lastrow As Range                    NombreHoja = "Log"     NumFactura = ThisWorkbook.Sheets("Estado").Range("ValCliente").Value     nombredearchivo = "Estado"     Ruta = "C:\Users\jfamilia\Desktop\archivos bck\Archivos Clinimed\Archivos\Estados de cuentas"          Worksheets("Estado").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _                     Ruta & "\" & "Estado De Cuenta-" & NumFactura & ".pdf", Quality:=xlQualityStandard, _                     IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True '----- Defining Variables With ThisWorkbook.Sheets(NombreHoja)     For i = 1 To 1         Set HojaDestino = ThisWorkbook.Sheets(NombreHoja).Range("A1").CurrentRegion         NuevaFila = HojaDestino.rows.Count + 1         .Cells(NuevaFila, 1).Value = Date         .Cells(NuevaFila, 2).Value = Range("ValCliente").Value         .Cells(NuevaFila, 3).Value = Range("ValCodigo").Value         .Cells(NuevaFila, 4).Value = Range("ValCorte").Value         .Cells(NuevaFila, 5).Value = Range("ValBalance").Value         .Cells(NuevaFila, 6).Value = Range("ValAtraso").Value         .Cells(NuevaFila, 7).Value = Range("ValFacVen").Value                               Next i End With MsgBox "Alta exitosa", vbInformation, "EXCELeINFO" End Sub
    • Buenas, @DeadGoreRed Entiendo que ese código lo has grabado desde la grabadora de macros. Algo muy sencillo sería que identificaras una casilla en concreto de cada hoja (puede ser la misma o diferente) y chequearas si tiene o no datos, es decir, si no cumple la condición para que siga ejecutándose el código. Si no lo cumple, puedes incluir algo del tipo "Goto..." para pasar a otra zona del código donde se encuentre la siguiente hoja a chequear. La mejor opción en el caso de que todas tus hojas tuvieran una estructura de datos iguales es que incluyeras al inicio un bucle del tipo "For each" para que pasara por cada hoja del libro y en caso de cumplirse la condición ejecutara el código. Así no tendrías ese código tan largo para hacer lo mismo en cada hoja. Si te parece bien la idea, podemos intentar incluir esas pequeñas modificaciones y lo pruebas. Un saludo, Tese
    • Sub FORMATO() ' ' TEXTO_COLUMNAS Macro '      Sheets("A-S1-001").Select          Range("J2").Select     Range(Selection, Selection.End(xlDown)).Select     Range(Selection, Selection.End(xlDown)).Select     Selection.TextToColumns Destination:=Range("J2"), DataType:=xlFixedWidth, _         FieldInfo:=Array(Array(0, 9), Array(10, 1)), TrailingMinusNumbers:=True     Selection.NumberFormat = "h:mm:ss"     Range("K2").Select     Range(Selection, Selection.End(xlDown)).Select     Range(Selection, Selection.End(xlDown)).Select     Selection.ClearContents     Range("K2").Select     Application.CutCopyMode = False     ActiveCell.FormulaR1C1 = "=RC[-1]-R[1]C[-1]"     Range("K2").Select     Selection.Copy     Range("K2:K1001").Select     ActiveSheet.Paste     Selection.End(xlUp).Select     Columns("K:K").Select     Application.CutCopyMode = False     Selection.Copy     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _         :=False, Transpose:=False     Application.CutCopyMode = False     Range("K1").Select     Selection.AutoFilter     ActiveSheet.Range("$A$1:$N$1001").AutoFilter Field:=11, Criteria1:= _         "00:00:00"     Range("K1000").Select     Range(Selection, Selection.End(xlDown)).Select     Selection.ClearContents     Range("K1").Select     ActiveSheet.Range("$A$1:$N$1001").AutoFilter Field:=11     Range("K2").Select     ActiveWorkbook.Worksheets("A-S1-001").Sort.SortFields.Clear     ActiveWorkbook.Worksheets("A-S1-001").Sort.SortFields.Add2 Key:=Range( _         "K2:K1000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _         xlSortNormal     With ActiveWorkbook.Worksheets("A-S1-002").Sort         .SetRange Range("A2:N1000")         .Header = xlNo         .MatchCase = False         .Orientation = xlTopToBottom         .SortMethod = xlPinYin         .Apply     End With     Selection.End(xlUp).Select     Selection.End(xlToLeft).Select          Sheets("A-S1-002").Select          Range("J2").Select     Range(Selection, Selection.End(xlDown)).Select     Range(Selection, Selection.End(xlDown)).Select     Selection.TextToColumns Destination:=Range("J2"), DataType:=xlFixedWidth, _         FieldInfo:=Array(Array(0, 9), Array(10, 1)), TrailingMinusNumbers:=True     Selection.NumberFormat = "h:mm:ss"     Range("K2").Select     Range(Selection, Selection.End(xlDown)).Select     Range(Selection, Selection.End(xlDown)).Select     Selection.ClearContents     Range("K2").Select     Application.CutCopyMode = False     ActiveCell.FormulaR1C1 = "=RC[-1]-R[1]C[-1]"     Range("K2").Select     Selection.Copy     Range("K2:K1001").Select     ActiveSheet.Paste     Selection.End(xlUp).Select     Columns("K:K").Select     Application.CutCopyMode = False     Selection.Copy     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _         :=False, Transpose:=False     Application.CutCopyMode = False     Range("K1").Select     Selection.AutoFilter     ActiveSheet.Range("$A$1:$N$1002").AutoFilter Field:=11, Criteria1:= _         "00:00:00"     Range("K1000").Select     Range(Selection, Selection.End(xlDown)).Select     Selection.ClearContents     Range("K1").Select     ActiveSheet.Range("$A$1:$N$1002").AutoFilter Field:=11     Range("K2").Select     ActiveWorkbook.Worksheets("A-S1-004").Sort.SortFields.Clear     ActiveWorkbook.Worksheets("A-S1-004").Sort.SortFields.Add2 Key:=Range( _         "K2:K1000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _         xlSortNormal     With ActiveWorkbook.Worksheets("A-S1-002").Sort         .SetRange Range("A2:N1000")         .Header = xlNo         .MatchCase = False         .Orientation = xlTopToBottom         .SortMethod = xlPinYin         .Apply     End With     Selection.End(xlUp).Select     Selection.End(xlToLeft).Select          Sheets("A-S1-003").Select          Range("J2").Select     Range(Selection, Selection.End(xlDown)).Select     Range(Selection, Selection.End(xlDown)).Select     Selection.TextToColumns Destination:=Range("J2"), DataType:=xlFixedWidth, _         FieldInfo:=Array(Array(0, 9), Array(10, 1)), TrailingMinusNumbers:=True     Selection.NumberFormat = "h:mm:ss"     Range("K2").Select     Range(Selection, Selection.End(xlDown)).Select     Range(Selection, Selection.End(xlDown)).Select     Selection.ClearContents     Range("K2").Select     Application.CutCopyMode = False     ActiveCell.FormulaR1C1 = "=RC[-1]-R[1]C[-1]"     Range("K2").Select     Selection.Copy     Range("K2:K1001").Select     ActiveSheet.Paste     Selection.End(xlUp).Select     Columns("K:K").Select     Application.CutCopyMode = False     Selection.Copy     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _         :=False, Transpose:=False     Application.CutCopyMode = False     Range("K1").Select     Selection.AutoFilter     ActiveSheet.Range("$A$1:$N$1001").AutoFilter Field:=11, Criteria1:= _         "00:00:00"     Range("K1000").Select     Range(Selection, Selection.End(xlDown)).Select     Selection.ClearContents     Range("K1").Select     ActiveSheet.Range("$A$1:$N$1000").AutoFilter Field:=11     Range("K2").Select     ActiveWorkbook.Worksheets("A-S1-003").Sort.SortFields.Clear     ActiveWorkbook.Worksheets("A-S1-003").Sort.SortFields.Add2 Key:=Range( _         "K2:K1000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _         xlSortNormal     With ActiveWorkbook.Worksheets("A-S1-003").Sort         .SetRange Range("A2:N1000")         .Header = xlNo         .MatchCase = False         .Orientation = xlTopToBottom         .SortMethod = xlPinYin         .Apply     End With     Selection.End(xlUp).Select     Selection.End(xlToLeft).Select Módulo3.bas
    • Hola Antoni. El libro en cuestión no tiene ninguna macro. ¿UDF? ¿QUE ES? El libro tiene 41 hojas. Una por cada VALOR del IBEX 35 más 6 de propios cálculos. El cursor parpadea varias veces cada minuto al actualizarse AHORA(). Si pongo macros para actualizar Ahora() cada segundo, el parpadeo es casi constante. El libro es de PETETE (gordo), 36,2 MB. Muchísimas gracias por tu atención. P.D. ¿Podría ser la consulta a WEB de BOLSA MADRID?
    • Sin entrar en la solución que te propone @Antoni, que dado quién lo hace funcionará estupendamente, ¿has pensado en utilizar un Combobox en lugar de un Textbox para filtrar por año? Quizás podrías cargarlo cuando haces el primer filtrado del TextBox, de manera que te aparecieran las opciones posibles del valor AÑO para ese cliente al desplegar el Combobox. Un saludo a todos, Tese
  • Recently Browsing

    • No registered users viewing this page.
×
×
  • Create New...

Important Information

Privacy Policy