Nomenclatura macro de catia a excel
yg_be Mensajes publicados 23437 Fecha de registro Estado Colaborador Última intervención -
hola, soy principiante en vba, estoy intentando hacer una macro que exporte un listado de nomenclaturas de catia a excel (ver la imagen de formato), pero todas mis operaciones no se están tomando en cuenta, ¿podrían decirme dónde cometo un error?
-- macro catia -- Sub CATMain() ' Verificar si el documento activo es un CATProduct On Error Resume Next Set myDocument = CATIA.ActiveDocument If Err.Number <> 0 Then MsgBox "No hay ningún archivo abierto en CATIA", vbCritical, "Error" End End If If TypeName(myDocument) <> "ProductDocument" Then MsgBox "El documento activo debe ser un CATProduct", vbCritical, "Error" End End If Set myProduct = myDocument.Product ' exportar lista de materiales Dim productDocument1 As ProductDocument Set productDocument1 = CATIA.ActiveDocument Dim product1 As Product Set product1 = productDocument1.Product Dim assemblyConvertor1 As AssemblyConvertor Set assemblyConvertor1 = product1.GetItem("BillOfMaterial") Dim arrayOfVariantOfBSTR5(11) arrayOfVariantOfBSTR5(0) = "Cantidad" arrayOfVariantOfBSTR5(1) = "Tipo" arrayOfVariantOfBSTR5(2) = "Referencia" arrayOfVariantOfBSTR5(3) = "Revisión" arrayOfVariantOfBSTR5(4) = "Definición" arrayOfVariantOfBSTR5(5) = "Nomenclatura" arrayOfVariantOfBSTR5(6) = "Fuente" arrayOfVariantOfBSTR5(7) = "MASS" arrayOfVariantOfBSTR5(8) = "MATERIA" arrayOfVariantOfBSTR5(9) = "ARTÍCULO" arrayOfVariantOfBSTR5(10) = "PROVEEDOR" Set assemblyConvertor1Variant = assemblyConvertor1 assemblyConvertor1Variant.SetCurrentFormat arrayOfVariantOfBSTR5 Dim arrayOfVariantOfBSTR6(11) arrayOfVariantOfBSTR6(0) = "Cantidad" arrayOfVariantOfBSTR6(1) = "Tipo" arrayOfVariantOfBSTR6(2) = "Referencia" arrayOfVariantOfBSTR6(3) = "Revisión" arrayOfVariantOfBSTR6(4) = "Definición" arrayOfVariantOfBSTR6(5) = "Nomenclatura" arrayOfVariantOfBSTR6(6) = "Fuente" arrayOfVariantOfBSTR6(7) = "MASS" arrayOfVariantOfBSTR6(8) = "MATERIA" arrayOfVariantOfBSTR6(9) = "ARTÍCULO" arrayOfVariantOfBSTR6(10) = "PROVEEDOR" Set assemblyConvertor1Variant = assemblyConvertor1 assemblyConvertor1Variant.SetSecondaryFormat arrayOfVariantOfBSTR6 assemblyConvertor1.[Print] "XLS", "C:\Temp\export.xls", product1 Set wb = ExcelApp.Workbook.Open(chemin) Dim ExcelApp As Object Dim Workbook As Object Dim CheminFichier As String Dim cheminfichier2 As String ' Especifique la ruta completa de su archivo Excel CheminFichier = "C:\Temp\export.xls" cheminfichier2 = "C:\Temp\modifexcel.xlsm" ' Crear una instancia de Excel Set ExcelApp = CreateObject("Excel.Application") ' Hacer Excel visible (opcional) ExcelApp.Visible = True ' Abrir el archivo de Excel Set Workbook = ExcelApp.Workbooks.Open(CheminFichier) Set Workbook = ExcelApp.Workbooks.Open(cheminfichier2) ' Ejecutar una macro del libro abierto objExcel.Run "bommodif" End Sub -- macro excel-- Sub bommodif() ' ' Macro bommodif ' ' Dim condition1 As String Dim condition2 As String Dim condition3 As String Dim condition4 As String Dim condition5 As String Dim motrecherche As String Dim motrecherche2 As String Dim resultat As String Dim trouve As Boolean Dim debut As Range Dim cell As Range Dim foundcell As Range Dim foundcell2 As Range Dim i As Long Dim j As Long Dim k As Long Dim a As Long Dim b As Long Dim ligne As Long Dim lastrowsource As Long Dim lastrowdestination As Long Dim lastrowdestination2 As Long Dim wbsource As Worksheet Dim wbdestionation As Worksheet Dim dict As Object Dim dict2 As Object Dim sourceworkbook As Workbook Dim sourcesheet As Worksheet Dim destinationworkbook As Workbook Dim destinationsheet As Worksheet Dim destinationsheet2 As Worksheet ' copiar los datos de export.xls a este archivo Set sourceworkbook = Workbooks.Open("C:\temp\export.xls") Set sourcesheet = sourceworkbook.Feuil1 Set destinationworkbook = Workbooks.Open("C:\temp\modifexcel.xlsm") Set destinationsheet = destinationworkbook.Feuil1 sourcesheet.UsedRange.Copy destinationsheet.Range("A1") sourceworkbook.Close ' crear una nueva hoja en el libro "modifexcel" destinationworkbook.Select nomfeuille = "feuil2" On Error Resume Next Set destinationworkbook = Workbooks.Open("C:\temp\modifexcel.xlsm") Set destinationsheet2 = destinationworkbook.Sheets(nomfeuille) On Error GoTo 0 If destinationsheet2 Is Nothing Then Set destinationsheet2 = destinationworkbook.Sheets.Add(After:=destinationworkbook.Sheets(destinationworkbook.Sheets.Count)) destinationsheet2.Name = nomfeuille End If ' borrar los datos y el formato eventualmente de la hoja 2 Sheets("feuil2").Select Cells.Select Selection.ClearContents With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With ' copiar pegar los títulos de las columnas Sheets("feuil1").Select Range("A4:K4").Select Selection.Copy Sheets("Feuil2").Select Range("A2").Select ActiveSheet.Paste ' formato de la tabla (ancho, texto centrado) Range("A:A,B:B,D:D,G:G,H:H").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Range("C2,E2,F2,I2,J2,K2").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Range("A:A,D:D,G:G,H:H").Select Selection.ColumnWidth = 8 Range("F:F,I:I,J:J,K:K").Select Selection.ColumnWidth = 30 Columns("B:B").Select Selection.ColumnWidth = 12 Columns("C:C").Select Selection.ColumnWidth = 40 Columns("E:E").Select Selection.ColumnWidth = 45 Range("A2:K2").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent3 .TintAndShade = 0.799981688894314 .PatternTintAndShade = 0 End With ' adición de la fila título para los ensamblajes Range("A3").Select ActiveCell.FormulaR1C1 = "ENSAMBLE" Range("A3:K3").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.NumberFormat = "@" Range("A3:K3").Select With Selection .HorizontalAlignment = xlCenterAcrossSelection .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With ' copiar pegar los datos relacionados con los ensamblajes con condición "ensamble" condition1 = "Ensamble" Set wbsource = Sheets("feuil1") lastrowsource = wbsource.Cells(Rows.Count, 1).End(xlUp).Row Set wbdestination = Sheets("feuil2") lastrowdestination = 4 For i = 1 To lastrowsource If wbsource.Cells(i, 2).Value = condition1 Then wbsource.Rows(i).Copy wbdestination.Rows(lastrowdestination) lastrowdestination = lastrowdestination + 1 End If Next i ' adición de la fila título para las "piezas fabricadas" teniendo en cuenta el número aleatorio de filas añadidas para los ensamblajes a = wbdestination.Cells(Rows.Count, 1).End(xlUp).Row Cells(a + 1, 1).Select ActiveCell.FormulaR1C1 = "PIEZA FABRICADA" Range(Cells(a + 1, 1), Cells(a + 1, 11)).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.NumberFormat = "@" Range(Cells(a + 1, 1), Cells(a + 1, 11)).Select With Selection .HorizontalAlignment = xlCenterAcrossSelection .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With ' copiar pegar los datos "piezas fabricadas" con búsqueda desde una palabra clave y condiciones "piezas" "fabricadas" motrecherche = "Resumen" condition2 = "Pieza" condition3 = "Fabricado" lastrowdestination = lastrowdestination + 1 Set dict = CreateObject("scripting.dictionary") Set foundcell = wbsource.Columns(1).Find(motrecherche, LookIn:=xlValues, LookAt:=xlWhole) If Not foundcell Is Nothing Then For j = foundcell.Row To lastrowsource If wbsource.Cells(j, 2).Value Like condition2 And wbsource.Cells(j, 7).Value Like condition3 Then Dim key As String key = wbsource.Cells(j, 3).Value & "|" If Not dict.exists(key) Then dict.Add key, Nothing wbsource.Rows(j).Copy wbdestination.Rows(lastrowdestination) lastrowdestination = lastrowdestination + 1 End If End If Next j End If ' adición de la fila título para las "piezas compradas" teniendo en cuenta el número aleatorio de filas añadidas para las piezas fabricadas b = wbdestination.Cells(Rows.Count, 1).End(xlUp).Row Cells(b + 1, 1).Select ActiveCell.FormulaR1C1 = "PIEZA COMPRADA" Range(Cells(b + 1, 1), Cells(b + 1, 11)).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.NumberFormat = "@" Range(Cells(b + 1, 1), Cells(b + 1, 11)).Select With Selection .HorizontalAlignment = xlCenterAcrossSelection .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With ' copiar pegar los datos "piezas compradas" con búsqueda desde una palabra clave y condiciones "piezas" "compradas" motrecherche = "Resumen" condition2 = "Pieza" condition4 = "Comprado" lastrowdestination = lastrowdestination + 1 Set dict = CreateObject("scripting.dictionary") Set foundcell = wbsource.Columns(1).Find(motrecherche, LookIn:=xlValues, LookAt:=xlWhole) If Not foundcell Is Nothing Then For j = foundcell.Row To lastrowsource If wbsource.Cells(j, 2).Value Like condition2 And wbsource.Cells(j, 7).Value Like condition4 Then Dim key2 As String key2 = wbsource.Cells(j, 3).Value & "|" If Not dict.exists(key) Then dict.Add key, Nothing wbsource.Rows(j).Copy wbdestination.Rows(lastrowdestination) lastrowdestination = lastrowdestination + 1 End If End If Next j End If End Sub 7 respuestas
-
Hola
Primero, hagan al menos un esfuerzo de revisión del post, sin plugin de reindentación de código en un editor de texto externo, ¡rápidamente se convierte en un problema!
Es ILEGIBLE en esta página.
Me he concentrado solo en la función CATMain() y ya hay cosas que revisar. La macro es tan densa que dejo a los demás asistentes motivados que se atrevan ^^'
Aquí está mi revisión de la función.
-- macro catia -- Sub CATMain() ' Verificar si el documento activo es un CATProduct On Error Resume Next Set myDocument = CATIA.ActiveDocument If Err.Number <> 0 Then MsgBox "No hay ningún archivo abierto en CATIA", vbCritical, "Error" End End If If TypeName(myDocument) <> "ProductDocument" Then MsgBox "El documento activo debe ser un CATProduct", vbCritical, "Error" End End If Set myProduct = myDocument.Product ' exportar lista de materiales Dim productDocument1 As ProductDocument Set productDocument1 = CATIA.ActiveDocument Dim product1 As Product Set product1 = productDocument1.Product Dim assemblyConvertor1 As AssemblyConvertor Set assemblyConvertor1 = product1.GetItem("BillOfMaterial") '##################################################################################### ' Dim arrayOfVariantOfBSTR5(11) reserva un array de 12 elementos, cuenta el 0 ' Uso de 0 a 10 para mayor claridad en el código '##################################################################################### Dim arrayOfVariantOfBSTR5(0 To 10) arrayOfVariantOfBSTR5(0) = "Cantidad" arrayOfVariantOfBSTR5(1) = "Tipo" arrayOfVariantOfBSTR5(2) = "Referencia" arrayOfVariantOfBSTR5(3) = "Revisión" arrayOfVariantOfBSTR5(4) = "Definición" arrayOfVariantOfBSTR5(5) = "Nomenclatura" arrayOfVariantOfBSTR5(6) = "Fuente" arrayOfVariantOfBSTR5(7) = "MASS" arrayOfVariantOfBSTR5(8) = "MATERIAL" arrayOfVariantOfBSTR5(9) = "ARTÍCULO" arrayOfVariantOfBSTR5(10) = "PROVEEDOR" '##################################################################################### ' Definir el tamaño de assemblyConvertor1Variant '##################################################################################### Dim assemblyConvertor1Variant As Variant Set assemblyConvertor1Variant = assemblyConvertor1 assemblyConvertor1Variant.SetCurrentFormat arrayOfVariantOfBSTR5 '##################################################################################### ' Dim arrayOfVariantOfBSTR5(11) reserva un array de 12 elementos, cuenta el 0 ' Uso de 0 a 10 para mayor claridad en el código '##################################################################################### Dim arrayOfVariantOfBSTR6(0 To 10) arrayOfVariantOfBSTR6(0) = "Cantidad" arrayOfVariantOfBSTR6(1) = "Tipo" arrayOfVariantOfBSTR6(2) = "Referencia" arrayOfVariantOfBSTR6(3) = "Revisión" arrayOfVariantOfBSTR6(4) = "Definición" arrayOfVariantOfBSTR6(5) = "Nomenclatura" arrayOfVariantOfBSTR6(6) = "Fuente" arrayOfVariantOfBSTR6(7) = "MASS" arrayOfVariantOfBSTR6(8) = "MATERIAL" arrayOfVariantOfBSTR6(9) = "ARTÍCULO" arrayOfVariantOfBSTR6(10) = "PROVEEDOR" '##################################################################################### ' SetSecondaryFormat redefine assemblyConvertor1Variant '##################################################################################### assemblyConvertor1Variant.SetSecondaryFormat arrayOfVariantOfBSTR6 '##################################################################################### ' Print es una función '##################################################################################### assemblyConvertor1.Print "XLS", "C:\Temp\export.xls", product1 '##################################################################################### ' Set wb = ExcelApp.Workbook.Open(caminho) ' wb nunca se utiliza '##################################################################################### Dim ExcelApp As Object Dim Workbook As Object '##################################################################################### ' Dim CheminFichier As String nunca se utiliza, ver línea 100 ' Atención a la capitalización, hay CheminFichier y cheminfichier para 2 variables similares ! '##################################################################################### Dim cheminfichier2 As String ' Especificar la ruta completa de su archivo Excel CheminFichier = "C:\Temp\export.xls" cheminfichier2 = "C:\Temp\modifexcel.xlsm" ' Crear una instancia de Excel Set ExcelApp = CreateObject("Excel.Application") ' Hacer visible Excel (opcional) ExcelApp.Visible = True ' Abrir el archivo de Excel '##################################################################################### ' Set Workbook = ExcelApp.Workbooks.Open(CheminFichier) ' Esta línea es innecesaria, Workbook se redefine de inmediato '##################################################################################### Set Workbook = ExcelApp.Workbooks.Open(cheminfichier2) ' Ejecutar una macro del libro abierto '##################################################################################### ' objExcel no se define en ningún lugar aquí '##################################################################################### ExcelApp.Run "bommodif" End SubPara los motivados, aquí hay una versión indentada de la macro.
-- macro excel-- Sub bommodif() ' macro bommodif Dim condition1 As String Dim condition2 As String Dim condition3 As String Dim condition4 As String Dim condition5 As String Dim motrecherche As String Dim motrecherche2 As String Dim resultat As String Dim trouve As Boolean Dim debut As Range Dim cell As Range Dim foundcell As Range Dim foundcell2 As Range Dim i As Long Dim j As Long Dim k As Long Dim a As Long Dim b As Long Dim ligne As Long Dim lastrowsource As Long Dim lastrowdestination As Long Dim lastrowdestination2 As Long Dim wbsource As Worksheet Dim wbdestionation As Worksheet Dim dict As Object Dim dict2 As Object Dim sourceworkbook As Workbook Dim sourcesheet As Worksheet Dim destinationworkbook As Workbook Dim destinationsheet As Worksheet Dim destinationsheet2 As Worksheet ' copiar los datos de export.xls a este archivo Set sourceworkbook = Workbooks.Open("C:\temp\export.xls") Set sourcesheet = sourceworkbook.Feuil1 Set destinationworkbook = Workbooks.Open("C:\temp\modifexcel.xlsm") Set destinationsheet = destinationworkbook.Feuil1 sourcesheet.UsedRange.Copy destinationsheet.Range("A1") sourceworkbook.Close ' crear una nueva hoja en el libro "modifexcel" destinationworkbook.Select nomfeuille = "feuil2" On Error Resume Next Set destinationworkbook = Workbooks.Open("C:\temp\modifexcel.xlsm") Set destinationsheet2 = destinationworkbook.Sheets(nomfeuille) On Error GoTo 0 If destinationsheet2 Is Nothing Then Set destinationsheet2 = destinationworkbook.Sheets.Add(After:=destinationworkbook.Sheets(destinationworkbook.Sheets.Count)) destinationsheet2.Name = nomfeuille End If ' borrar los datos y el formato de la hoja 2 Sheets("feuil2").Select Cells.Select Selection.ClearContents With Selection.Interior .Pattern = xlNone .TintAndShade = 0 .PatternTintAndShade = 0 End With ' copiar y pegar títulos de columnas Sheets("feuil1").Select Range("A4:K4").Select Selection.Copy Sheets("Feuil2").Select Range("A2").Select ActiveSheet.Paste ' formato de la tabla (ancho, texto centrado) Range("A:A,B:B,D:D,G:G,H:H").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Range("C2,E2,F2,I2,J2,K2").Select With Selection .HorizontalAlignment = xlCenter .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Range("A:A,D:D,G:G,H:H").Select Selection.ColumnWidth = 8 Range("F:F,I:I,J:J,K:K").Select Selection.ColumnWidth = 30 Columns("B:B").Select Selection.ColumnWidth = 12 Columns("C:C").Select Selection.ColumnWidth = 40 Columns("E:E").Select Selection.ColumnWidth = 45 Range("A2:K2").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorAccent3 .TintAndShade = 0.799981688894314 .PatternTintAndShade = 0 End With ' adición de la línea título para los ensamblajes Range("A3").Select ActiveCell.FormulaR1C1 = "ENSAMBLE" Range("A3:K3").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.NumberFormat = "@" Range("A3:K3").Select With Selection .HorizontalAlignment = xlCenterAcrossSelection .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With ' copiar y pegar los datos referentes a los ensamblajes con condición "ensamble" condition1 = "Ensamble" Set wbsource = Sheets("feuil1") lastrowsource = wbsource.Cells(Rows.Count, 1).End(xlUp).Row Set wbdestination = Sheets("feuil2") lastrowdestination = 4 For i = 1 To lastrowsource If wbsource.Cells(i, 2).Value = condition1 Then wbsource.Rows(i).Copy wbdestination.Rows(lastrowdestination) lastrowdestination = lastrowdestination + 1 End If Next i ' adición de la línea título para las "piezas fabricadas" teniendo en cuenta el número aleatorio de líneas añadidas para los ensamblajes a = wbdestination.Cells(Rows.Count, 1).End(xlUp).Row Cells(a + 1, 1).Select ActiveCell.FormulaR1C1 = "PIEZA FABRICADA" Range(Cells(a + 1, 1), Cells(a + 1, 11)).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.NumberFormat = "@" Range(Cells(a + 1, 1), Cells(a + 1, 11)).Select With Selection .HorizontalAlignment = xlCenterAcrossSelection .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With ' copiar y pegar los datos "piezas fabricadas" con búsqueda desde una palabra clave y condiciones "piezas" "fabricadas" motrecherche = "Resumen" condition2 = "Pieza" condition3 = "Fabricado" lastrowdestination = lastrowdestination + 1 Set dict = CreateObject("scripting.dictionary") Set foundcell = wbsource.Columns(1).Find(motreiche, LookIn:=xlValues, LookAt:=xlWhole) If Not foundcell Is Nothing Then For j = foundcell.Row To lastrowsource If wbsource.Cells(j, 2).Value Like condition2 And wbsource.Cells(j, 7).Value Like condition3 Then Dim key As String key = wbsource.Cells(j, 3).Value & "|" If Not dict.exists(key) Then dict.Add key, Nothing wbsource.Rows(j).Copy wbdestination.Rows(lastrowdestination) lastrowdestination = lastrowdestination + 1 End If End If Next j End If ' adición de la línea título para las "piezas compradas" teniendo en cuenta el número aleatorio de líneas añadidas para las piezas fabricadas b = wbdestination.Cells(Rows.Count, 1).End(xlUp).Row Cells(b + 1, 1).Select ActiveCell.FormulaR1C1 = "PIEZA COMPRADA" Range(Cells(b + 1, 1), Cells(b + 1, 11)).Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 65535 .TintAndShade = 0 .PatternTintAndShade = 0 End With Selection.NumberFormat = "@" Range(Cells(b + 1, 1), Cells(b + 1, 11)).Select With Selection .HorizontalAlignment = xlCenterAcrossSelection .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With ' copiar y pegar los datos "piezas compradas" con búsqueda desde una palabra clave y condiciones "piezas" "compradas" motrecherche = "Resumen" condition2 = "Pieza" condition4 = "Comprado" lastrowdestination = lastrowdestination + 1 Set dict = CreateObject("scripting.dictionary") Set foundcell = wbsource.Columns(1).Find(motrecherche, LookIn:=xlValues, LookAt:=xlWhole) If Not foundcell Is Nothing Then For j = foundcell.Row To lastrowsource If wbsource.Cells(j, 2).Value Like condition2 And wbsource.Cells(j, 7).Value Like condition4 Then Dim key2 As String key2 = wbsource.Cells(j, 3).Value & "|" If Not dict.exists(key2) Then dict.Add key2, Nothing wbsource.Rows(j).Copy wbdestination.Rows(lastrowdestination) lastrowdestination = lastrowdestination + 1 End If End If Next j End If End Sub
¡Las MAANG no tienen petróleo, pero tienen datos!
¿Lo sientes mi Big Data?
Sacrifica algunas libertades por más seguridad y las pierdes TODAS.
TODAS SUS BASES DE DATOS SON NUESTROS -
yg_be Mensajes publicados 23437 Fecha de registro Estado Colaborador Última intervención Ambassadeur 1 588
hola,
¿puedes compartir tu archivo y precisar las divergencias entre lo que obtienes y lo que esperas?
-
hola
gracias a luckydu43 por tu respuesta, lamento si mi publicación es ininteligible, solo es la segunda vez que uso este sitio y hice un simple copiar/pegar de mis macros
yg_be, ¿cómo puedo compartirte mi archivo?
-
Hola,
Puedes ponerlo en "Cjoint" y pegar en tu respuesta el enlace que habrás solicitado.
-
https://www.cjoint.com/c/NJEmSMmakXX
De hecho, me fui de Catia V5 de un producto, generé una lista de materiales que guardé en export.xls, de allí creé una macro que me permite compilar los datos en una tabla ordenada.
Pero cuando ejecuto la macro en Catia, nada sucede en mi archivo de Excel.
Lo que me gustaría obtener se encuentra en la hoja 2 del archivo Excel "ess11.xlsm".
-
hola
Cuando ejecuto la macro desde Catia, abre correctamente los dos archivos de Excel requeridos "export.xls" y "modifexcel.xlsm", en el archivo "export.xls" tengo los datos deseados, es decir, "la lista de materiales" del producto Catia abierto.
Es después que no funciona más.
Lo que me gustaría obtener es:ejecutar la macro "essai.catvba" desde CATIA V5
luego, a partir de los datos exportados que encontramos en "export.xls", crear una tabla ordenada (ver diseño deseado en el archivo Excel "ess11.xlsm" hoja2) que la tabla creada esté en el archivo "export.xls" o "modifexcel.xlsm" me importa poco y que luego sea guardada.
si es posible lanzando solo la macro desde Catia.
en el archivo "ess11.xlsm" existe una macro "zz" que hace el trabajo solicitado con una excepción: no consigo obtener la lista completa de las piezas compradas.
Para resumir, a partir de la macro "essai.catvba" ejecutada desde Catia, quiero obtener la tabla hoja2 del archivo "ess11.xlsm", es en cierta forma una mezcla entre las dos macros.
-
yg_be Mensajes publicados 23437 Fecha de registro Estado Colaborador Última intervención Ambassadeur 1 588
Lo primero que debes hacer es añadir "option explicit" al principio de cada módulo.
Eso te ayudará a corregir errores en los nombres de las variables.