Mejorar macro que será llamada muchas veces

reteima · Mensaje por **reteima** » Lun Ago 15, 2016 11:34 am

Hola a tod@s y gracias por anticipado.
He reconstruido una macro basada en la idea original de https://delphi.jmrds.com/node/77
Es para obtener información de los códigos de barra y será llamada muchas veces por otras macros.
Según he visto: nhttps://forum.openoffice.org/es/forum/viewtopic.php?f=50&t=10989&p=47287#p47279 tiene bastantes ineficiencias.
Solicito ayuda para optimizarla.

Código: Seleccionar todo

    Function  LerCBAR(Codigo As String)
    'devuelve información de los primeros n-dígitos de un código GS1-128
    If Mid(Codigo,1,2) = "00" Then
       AI = "00"
       Valor = Mid(Codigo,3,18)
       Empresa = Mid(Codigo,6,5)
       Digitos = 18
       Tipo = "rtNumero"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Serial Shipping Container"
       Codigo = Mid(Codigo,21,99)
       RestoCodigo = Codigo
       DescripUnds = "SerialShippingContainer"
       DescripCorta = "SSC"

    ElseIf Mid(Codigo,1,2) = "01" Then
       AI = "01"
       Valor = Mid(Codigo,3,14)
       Empresa = Mid(Codigo,6,5)
       Digitos = 14
       Tipo = "rtNumero"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Shipping Container Code"
       Codigo = Mid(Codigo,17,99)
       RestoCodigo = Codigo
       DescripUnds = "ShippingContainerCode"
       DescripCorta = "SCC"

    ElseIf Mid(Codigo,1,2) = "02" Then
       AI = "02"
       Valor = Mid(Codigo,3,14)
       Digitos = 14
       Empresa = Mid(Codigo,6,5)
       Tipo = "rtNumero"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Number of containers"
       Codigo = Mid(Codigo,17,99)
       RestoCodigo = Codigo
       DescripUnds = "NumberContainers"
       DescripCorta = "SSCC"

    ElseIf Mid(Codigo,1,2) = "10" Then
       AI = "10"
       Tipo = "rtTexto"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Batch Number"
       Valor = ""
       Digitos = 0
       Codigo = Mid(Codigo,3,99)
          Do while Len(Codigo) > 0
             Digitos = Digitos + 1
             C = Mid(Codigo,1,1)
             Codigo = Mid(Codigo,2,99)
             If C = Chr(29) Then
                Digitos = Digitos + 1
                Exit Do
             Else
                Valor = Valor & C
             End If
          Loop
       RestoCodigo = Codigo
       DescripUnds = "BatchNumber"
       DescripCorta = "Lote"

    ElseIf Mid(Codigo,1,2) = "11" Then
       AI = "11"
       Valor = Mid(Codigo,3,6)
       Digitos = 6
       Digitos = 6
       Tipo = "rtFecha"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Production Date"
       Codigo = Mid(Codigo,9,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductionDate"
       DescripCorta = "DFabric"

    ElseIf Mid(Codigo,1,2) = "13" Then
       AI = "13"
       Valor = Mid(Codigo,3,6)
       Digitos = 6
       Tipo = "rtFecha"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Packaging Date"
       Codigo = Mid(Codigo,9,99)
       RestoCodigo = Codigo
       DescripUnds = "PackagingDate"
       DescripCorta = "DPack"

    ElseIf Mid(Codigo,1,2) = "15" Then
       AI = "15"
       Valor = Mid(Codigo,3,6)
       Digitos = 6
       Tipo = "rtFecha"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Sell by Date"
       Codigo = Mid(Codigo,9,99)
       RestoCodigo = Codigo
       DescripUnds = "SellbyPrefDate"
       DescripCorta = "DCPref"

    ElseIf Mid(Codigo,1,2) = "17" Then
       AI = "17"
       Valor = Mid(Codigo,3,6)
       Digitos = 6
       Tipo = "rtFecha"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Expiration Date"
       Codigo = Mid(Codigo,9,99)
       RestoCodigo = Codigo
       DescripUnds = "ExpirationCadDate"
       DescripCorta = "DCaduc"

    ElseIf Mid(Codigo,1,2) = "20" Then
       AI = "20"
       Valor = Mid(Codigo,3,2)
       Digitos = 2
       Tipo = "rtNumero"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Product Variant"
       Codigo = Mid(Codigo,5,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductVariant"
       DescripCorta = "Variante"

    ElseIf Mid(Codigo,1,2) = "21" Then
       AI = "21"
       Tipo = "rtTexto"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Serial Number"
       Valor  =""
       Digitos = 0
       Codigo = Mid(Codigo,3,99)
          Do while Len(Codigo) > 0
             Digitos = Digitos + 1
             C = Mid(Codigo,1,1)
             Codigo = Mid(Codigo,2,99)
             If C = Chr(29) Then
                Digitos = Digitos + 1
                Exit Do
             Else
                Valor = Valor & C
             End If
          Loop
       RestoCodigo = Codigo
       DescripUnds = "SerialNumber"
       DescripCorta = "NSerie"

    ElseIf Mid(Codigo,1,2) = "30" Then
       AI = "30"
       Tipo = "rtNumero"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Count Items"
       Valor = ""
       Digitos = 0
       Codigo = Mid(Codigo,3,99)
          Do while Len(Codigo) > 0
             Digitos = Digitos + 1
             C = Mid(Codigo,1,1)
             Codigo = Mid(Codigo,2,99)
             If C = Chr(29) Then
                Digitos = Digitos + 1
                Exit Do
             Else
                Valor = Valor & C
             End If
          Loop
       RestoCodigo = Codigo
       DescripUnds = "CountUnds"
       DescripCorta = "Unds"

    ElseIf Mid(Codigo,1,3) = "310" Then
       AI = "310"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruKg"
       Description = "Product Net Weight"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductNetWeight"
       DescripCorta = "NetoKg"

    ElseIf Mid(Codigo,1,3) = "311" Then
       AI = "311"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruMetros"
       Description = "Product Length/1st Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductLengthMts"
       DescripCorta = "LonMts"

    ElseIf Mid(Codigo,1,3) = "312" Then
       AI = "312"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruMetros"
       Description = "Product Width/Diameter/2nd Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductWidth/DiameterMts"
       DescripCorta = "AnMts"

    ElseIf Mid(Codigo,1,3) = "313" Then
       AI = "313"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruMetros"
       Description = "Product Depth/Thickness/3rd Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductDepth/ThicknessMts"
       DescripCorta = "AltMts"

    ElseIf Mid(Codigo,1,3) = "314" Then
       AI = "314"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruMetros2"
       Description = "Product Area"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductAreaMts2"
       DescripCorta = "AreaMts2"

    ElseIf Mid(Codigo,1,3) = "315" Then
       AI = "315"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruLitros"
       Description = "Product Volume"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductVolumeLtrs"
       DescripCorta = "Litros"

    ElseIf Mid(Codigo,1,3) = "316" Then
       AI = "316"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruMetros3"
       Description = "Product Volume"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductVolumeMts3"
       DescripCorta = "Mts3"

    ElseIf Mid(Codigo,1,3) = "320" Then
       AI = "320"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruLibras"
       Description = "Product Net Weight"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductNetWeightLbs"
       DescripCorta = "Libs"

    ElseIf Mid(Codigo,1,3) = "321" Then
       AI = "321"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruPulgadas"
       Description = "Product Length/1st Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductLengthInch"
       DescripCorta = "LonInch"

    ElseIf Mid(Codigo,1,3) = "322" Then
       AI = "322"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruPies"
       Description = "Product Length/1st Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductLengthFeets"
       DescripCorta = "LonFeets"

    ElseIf Mid(Codigo,1,3) = "323" Then
       AI = "323"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruYardas"
       Description = "Product Length/1st Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductLengthYds"
       DescripCorta = "LonYds"

    ElseIf Mid(Codigo,1,3) = "324" Then
       AI = "324"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruPulgadas"
       Description = "Product Width/Diameter/2nd Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductWidthInch"
       DescripCorta = "AnchInch"

    ElseIf Mid(Codigo,1,3) = "325" Then
       AI = "325"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruPies"
       Description = "Product Width/Diameter/2nd Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductWidthFeets"
       DescripCorta = "AnchFeets"

    ElseIf Mid(Codigo,1,3) = "326" Then
       AI = "326"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruYardas"
       Description = "Product Width/Diameter/2nd Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductWidthYds"
       DescripCorta = "AnchYds"

    ElseIf Mid(Codigo,1,3) = "327" Then
       AI = "327"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruPulgadas"
       Description = "Product Depth/Thickness/3rd Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductDepthInch”"
       DescripCorta = "AltInch"

    ElseIf Mid(Codigo,1,3) = "328" Then
       AI = "328"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruPies"
       Description = "Product Depth/Thickness/3rd Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductDepthFeet"
       DescripCorta = "AltFeet"

    ElseIf Mid(Codigo,1,3) = "329" Then
       AI = "329"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruYardas"
       Description = "Product Depth/Thickness/3rd Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductDepthYds"
       DescripCorta = "AltYds"

    ElseIf Mid(Codigo,1,3) = "330" Then
       AI = "330"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruKg"
       Description = "Container Gross Weight"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerGrossWeightKg"
       DescripCorta = "ContBrutoKg"

    ElseIf Mid(Codigo,1,3) = "331" Then
       AI = "331"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruMetros"
       Description = "Container Length/1st Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerLengthMts”"
       DescripCorta = "ContLonMts”"

    ElseIf Mid(Codigo,1,3) = "332" Then
       AI = "332"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruMetros"
       Description = "Container Width/Diameter/2nd Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerWidthMts"
       DescripCorta = "ContAnchMts"

    ElseIf Mid(Codigo,1,3) = "333" Then
       AI = "333"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruMetros"
       Description = "Container Depth/Thickness/3rd Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerDepthMts"
       DescripCorta = "ContAltMts"

    ElseIf Mid(Codigo,1,3) = "334" Then
       AI = "334"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruMetros2"
       Description = "Container Area"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerAreaMts2"
       DescripCorta = "ContAreaMts2"

    ElseIf Mid(Codigo,1,3) = "335" Then
       AI = "335"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruLitros"
       Description = "Container Gross Volume"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerGrossVolumeLtrs"
       DescripCorta = "ContLtrs"

    ElseIf Mid(Codigo,1,3) = "336" Then
       AI = "336"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruMetros3"
       Description = "Container Gross Volume"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerGrossVolumeMts3"
       DescripCorta = "ContMts3"

    ElseIf Mid(Codigo,1,3) = "340" Then
       AI = "340"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruLibras"
       Description = "Container Gross Weight"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerGrossWeightLbs"
       DescripCorta = "ContLbs"

    ElseIf Mid(Codigo,1,3) = "341" Then
       AI = "341"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruPulgadas"
       Description = "Container Length/1st Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerLengthInch”"
       DescripCorta = "ContLonInch”"

    ElseIf Mid(Codigo,1,3) = "342" Then
       AI = "342"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruPies"
       Description = "Container Length/1st Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerLengthFeets"
       DescripCorta = "ContLonFeets"

    ElseIf Mid(Codigo,1,3) = "343" Then
       AI = "343"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruYardas"
       Description = "Container Length/1st Dimension in"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerLengthYds"
       DescripCorta = "ContLonYds"

    ElseIf Mid(Codigo,1,3) = "344" Then
       AI = "344"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruPulgadas"
       Description = "Container Width/Diamater/2nd Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerWidthInch"
       DescripCorta = "ContAnchInch"

    ElseIf Mid(Codigo,1,3) = "345" Then
       AI = "345"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruPies"
       Description = "Container Width/Diameter/2nd Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerWidthFeets"
       DescripCorta = "ContAnchFeets"

    ElseIf Mid(Codigo,1,3) = "346" Then
       AI = "346"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruYardas"
       Description = "Container Width/Diameter/2nd Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerWidthYds"
       DescripCorta = "ContAnchYds"

    ElseIf Mid(Codigo,1,3) = "347" Then
       AI = "347"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruPulgadas"
       Description = "Container Depth/Thickness/Height/3rd Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerDepthHeightInch”"
       DescripCorta = "ContAltInch”"

    ElseIf Mid(Codigo,1,3) = "348" Then
       AI = "348"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruPies"
       Description = "Container Depth/Thickness/Height/3rd Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerDepthHeightFeets”"
       DescripCorta = "ContAltFeets”"

    ElseIf Mid(Codigo,1,3) = "349" Then
       AI = "349"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruYardas"
       Description = "Container Depth/Thickness/Height/3rd Dimension"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerDepthHeightYds"
       DescripCorta = "ContAltYds"

    ElseIf Mid(Codigo,1,3) = "350" Then
       AI = "350"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruPulgadas2"
       Description = "Product Area"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductAreaInch2"
       DescripCorta = "AreaInch2"

    ElseIf Mid(Codigo,1,3) = "351" Then
       AI = "351"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruPies2"
       Description = "Product Area"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductAreaFeets2"
       DescripCorta = "AreaFeets2"

    ElseIf Mid(Codigo,1,3) = "352" Then
       AI = "352"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruYardas2"
       Description = "Product Area"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductAreaYds2"
       DescripCorta = "AreaYds2"

    ElseIf Mid(Codigo,1,3) = "353" Then
       AI = "353"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruPulgadas2"
       Description = "Container Area"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerAreaInch2"
       DescripCorta = "ContAreaInch2"

    ElseIf Mid(Codigo,1,3) = "354" Then
       AI = "354"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruPies2"
       Description = "Container Area"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerAreaFeets2"
       DescripCorta = "ContAreaFeets2"

    ElseIf Mid(Codigo,1,3) = "355" Then
       AI = "355"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruYardas2"
       Description = "Container Area"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerAreaYds2"
       DescripCorta = "ContAreaYds2"

    ElseIf Mid(Codigo,1,3) = "356" Then
       AI = "356"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruOnzas"
       Description = "Net Weight"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "NetWeightOunces"
       DescripCorta = "NetOunces"

    ElseIf Mid(Codigo,1,3) = "360" Then
       AI = "360"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruQuarts"
       Description = "Product Volume"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductVolumeQuarts"
       DescripCorta = "Quarts"

    ElseIf Mid(Codigo,1,3) = "361" Then
       AI = "361"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruGalones"
       Description = "Product Volume"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductVolumeGallons"
       DescripCorta = "Gallons"

    ElseIf Mid(Codigo,1,3) = "362" Then
       AI = "362"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruQuarts"
       Description = "Container Gross Volume"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerGrossVolumeQuarts"
       DescripCorta = "ContQuarts"

    ElseIf Mid(Codigo,1,3) = "363" Then
       AI = "363"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruGalones"
       Description = "Container Gross Volume"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerGrossVolumeGallons"
       DescripCorta = "ContGallons"

    ElseIf Mid(Codigo,1,3) = "364" Then
       AI = "364"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruPulgadas3"
       Description = "Product Volume"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductVolumeInch3"
       DescripCorta = "Inch3"

    ElseIf Mid(Codigo,1,3) = "365" Then
       AI = "365"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruPies3"
       Description = "Product Volume"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductVolumeFeets3"
       DescripCorta = "Feets3"

    ElseIf Mid(Codigo,1,3) = "366" Then
       AI = "366"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruYardas3"
       Description = "Product Volume"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ProductVolumeYds3"
       DescripCorta = "Yds3"

    ElseIf Mid(Codigo,1,3) = "367" Then
       AI = "364"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruPulgadas3"
       Description = "Container Gross Volume"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerGrossVolumeInch3"
       DescripCorta = "ContInch3"

    ElseIf Mid(Codigo,1,3) = "368" Then
       AI = "365"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruPies3"
       Description = "Container Gross Volume"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerGrossVolumeFeets3"
       DescripCorta = "ContFeets3"

    ElseIf Mid(Codigo,1,3) = "369" Then
       AI = "366"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = Val(Mid(Codigo,4,1))
       Unidades = "ruYardas3"
       Description = "Container Gross Volume"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "ContainerGrossVolumeYds3"
       DescripCorta = "ContYds3"

    ElseIf Mid(Codigo,1,2) = "37" Then
       AI = "37"
       Tipo = "rtNumero"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Number of Units Contained"
       Valor = ""
       Digitos = 0
       Codigo = Mid(Codigo,3,99)
          Do while Len(Codigo) > 0
             Digitos = Digitos + 1
             C = Mid(Codigo,1,1)
             Codigo = Mid(Codigo,2,99)
             If C = Chr(29) Then
                Digitos = Digitos + 1
                Print "29 detectado"
                Exit Do
             Else
                Valor = Valor & C
             End If
          Loop
       RestoCodigo = Codigo
       DescripUnds = "ProductUnitsContained"
       DescripCorta = "Unidades"

    ElseIf Mid(Codigo,1,3) = "400" Then
       AI = "400"
       Tipo = "rtTexto"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Customer Purchase Order Number"
       Valor =""
       Digitos = 0
       Codigo = Mid(Codigo,4,99)
          Do while Len(Codigo) > 0
             Digitos = Digitos + 1
             C = Mid(Codigo,1,1)
             Codigo = Mid(Codigo,2,99)
             If C = Chr(29) Then
                Digitos = Digitos + 1
                Exit Do
             Else
                Valor = Valor & C
             End If
          Loop
       RestoCodigo = Codigo
       DescripUnds = "CustomerPurchaseOrderNumber"
       DescripCorta = "NumPedido"
       
    '401   Número de consignación   n3+an..30
    '402   Número de Identificación del envío   n3+n17
    '403   Código de ruta   n3+an..30
    ElseIf Mid(Codigo,1,3) = "410" Then
       AI = "410"
       Valor = Mid(Codigo,4,13)
       Digitos = 13
       Tipo = "rtEAN13"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Ship To/Deliver To Location Code"
       Codigo = Mid(Codigo,17,99)
       RestoCodigo = Codigo
       DescripUnds = "ShipTo/DeliverToLocationCode"
       DescripCorta = "ExpedirA"

    ElseIf Mid(Codigo,1,3) = "411" Then
       AI = "411"
       Valor = Mid(Codigo,4,13)
       Digitos = 13
       Tipo = "rtEAN13"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Bill To/Invoice Location Code"
       Codigo = Mid(Codigo,17,99)
       RestoCodigo = Codigo
       DescripUnds = "BillTo/InvoiceLocationCode"
       DescripCorta = "FacturarA"

    ElseIf Mid(Codigo,1,3) = "412" Then
       AI = "412"
       Valor = Mid(Codigo,4,13)
       Digitos = 13
       Tipo = "rtEAN13"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Purchase From Location Code"
       Codigo = Mid(Codigo,17,99)
       RestoCodigo = Codigo
       DescripUnds = "PurchaseFromLocationCode"
       DescripCorta = "CompradoA"
       
    '413   Expedir para (entregar para – remitir a) punto operacional empleando GTIN-13   n3+n13
    '414   Punto operacional empleando GTIN-13   n3+n13
    '415   Punto operacional GLN de la línea de factura   n3+n13
    '420   Expedir a (entregar a) código postal dentro de una única Autoridad Postal   n3+n..20
    '421   Expedir a (entregar a) código postal precedido del código del país ISO (3 dígitos)   n3+n3+an..9

    '422   País de nacimiento del animal   n3+n3
    ElseIf Mid(Codigo,1,3) = "422" Then
       AI = "422"
       Valor = Mid(Codigo,4,3)
       Digitos = 3
       Tipo = "rtTexto"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Country of Origin (ISO country code)"
       Codigo = Mid(Codigo,7,99)
       RestoCodigo = Codigo
       DescripUnds = "CountryOrigin"
       DescripCorta = "PaisNac"
    '423   País de cebo   n3+n3+n..12   
    ElseIf Mid(Codigo,1,3) = "423" Then
       AI = "423"
       Tipo = "rtTexto"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Country or countries of initial processing"
       Valor =""
       Digitos = 0
       Codigo = Mid(Codigo,4,99)
          Do while Len(Codigo) > 0
             Digitos = Digitos + 1
             C = Mid(Codigo,1,1)
             Codigo = Mid(Codigo,2,99)
             If C = Chr(29) Then
                Digitos = Digitos + 1
                Exit Do
             Else
                Valor = Valor & C
             End If
          Loop
       RestoCodigo = Codigo
       DescripUnds = "CountryInitialProcessing"
       DescripCorta = "PaisCebo"
    '424   País de producción del producto   n3+n3   
    ElseIf Mid(Codigo,1,3) = "424" Then
       AI = "424"
       Valor = Mid(Codigo,4,3)
       Digitos = 3
       Tipo = "rtTexto"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Country of processing"
       Codigo = Mid(Codigo,7,99)
       RestoCodigo = Codigo
       DescripUnds = "CountryProcessing"
       DescripCorta = "PaisProducion"
    '425   País de despiece   n3+n3   
    ElseIf Mid(Codigo,1,3) = "425" Then
       AI = "425"
       Valor = Mid(Codigo,4,3)
       Digitos = 3
       Tipo = "rtTexto"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Country of disassembly"
       Codigo = Mid(Codigo,7,99)
       RestoCodigo = Codigo
       DescripUnds = "CountryDisassembly"
       DescripCorta = "PaisDespec"
    '426   País del proceso completo (nacido, cebado y sacrificado en un mismo país)   n3+n3   
    ElseIf Mid(Codigo,1,3) = "426" Then
       AI = "426"
       Valor = Mid(Codigo,4,3)
       Digitos = 3
       Tipo = "rtTexto"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Country of full process chain"
       Codigo = Mid(Codigo,7,99)
       RestoCodigo = Codigo
       DescripUnds = "CountryFullProcess"
       DescripCorta = "PaisProcesoComp"

    '7001   Número de stock   n4+n13
    '7002   Clasificación UN/ENE del corte y la carcasa   n4+an..30
    '7030   País sacrificio y RSI del matadero   n4+n3+an..27
    '703x   País de despiece y número registro sanitario del despiece   n4+n3+an..27

    ElseIf Mid(Codigo,1,4) = "8001" Then
       AI = "8001"
       Valor = Mid(Codigo,5,14)
       Digitos = 14
       Tipo = "rtNumero"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Roll Products - Width/Length/Core Diameter"
       Codigo = Mid(Codigo,19,99)
       RestoCodigo = Codigo
       DescripUnds = "RollProducts-Width/Length/CoreDiameter"
       DescripCorta = "BobinasAnchLongDiam"
    '8002   Número de serie electrónico para teléfonos móviles celulares   n4+an..20
    '8003   Número GTIN y número de serie de retornables   n4+n14+an..16
    '8004   Identificación GTIN seriada del activo   n4+an..30
    ElseIf Mid(Codigo,1,4) = "8004" Then
       AI = "8004"
       Tipo = "rtTexto"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "UPC/EAN Serial Identification"
       Valor =""
       Digitos = 0
       Codigo = Mid(Codigo,5,99)
          Do while Len(Codigo) > 0
             Digitos = Digitos + 1
             C = Mid(Codigo,1,1)
             Codigo = Mid(Codigo,2,99)
             If C = Chr(29) Then
                Digitos = Digitos + 1
                Exit Do
             Else
                Valor = Valor & C
             End If
          Loop
       RestoCodigo = Codigo
       DescripUnds = "UPC/EANSerialIdentification"
       DescripCorta = "IdentifGTINSerie"

    ElseIf Mid(Codigo,1,4) = "8005" Then
       AI = "8005"
       Valor = Mid(Codigo,5,6)
       Digitos = 6
       Tipo = "rtNumero"
       Decimales = 0
       Unidades = "ruNinguna"
       Description = "Price per Unit of Measure"
       Codigo = Mid(Codigo,11,99)
       RestoCodigo = Codigo
       DescripUnds = "PriceperUnitofMeasure"
       DescripCorta = "PrecioUnitario"
       
    '8006   Componente de un artículo   n4+n14+n2+n2
    '8007   Número de cuenta del banco   n4+an..30
    '8008   Fecha y tiempo de producción   n4+n8+n..4
    '8018   Número de identificación de servicio individualizado   n4+n18
    '8020   Número de referencia del pago   n4+an..25
    '8100   Código de cupón extendido - NSC + código de oferta   n4+n1+n5
    '8101   Código de cupón extendido - NSC + código de oferta + fin del código deCódigo de cupón extendido – NSC   n4+n1+n5+n4
    '8102   Código de cupón extendido – NSC   n4+n1+n1
    '90      Aplicaciones mutuamente acordadas   n2+an..30
    '91-99   Aplicaciones internas   n2+an..30

    Else
    '-----------------------------------------------------------------------------
    '   AI ="XX"      'AI desconocido
    '   'detectar fin → o restocodigo
    '   DescripUnds = "AI" & Mid(Codigo,1,2) & "desconocido"    'asumimos 2 dixitos
    '   DescripCorta =  DescripUnds
    '   Valor =""
    '   Digitos = 0
    '   Codigo = Mid(Codigo,3,99)
    '      Do while Len(Codigo) > 0
    '         C = Mid(Codigo,1,1)
    '         Codigo = Mid(Codigo,2,99)
    '         If C = Chr(29) Then
    '            Exit Do
    '         Else
    '            Digitos = Digitos + 1
    '            Valor = Valor & C
    '         End If
    '      Loop
    '   RestoCodigo = Codigo
    '----------------------------------------------------------------------------
       AI ="XX"      'AI desconocido    'detectar fin → o restocodigo
       Valor =""
       Digitos = 0

       If OutrosEAN Then
          If Codigo = CEAN(Mid(Codigo,1,Len(Codigo)-1), True) Then 'posible EAN porque el díxito control es ok
             Digitos = Len(Codigo)
             Select Case Digitos
                Case 13,14             'rango Codigos 200-299 internos
                   If Left(Codigo,1) = "2" Then
                      DescripCorta = "InternoEAN"
                   Else
                      DescripCorta = "EAN"
                   End If
                Case Else
                   DescripCorta = "non_identif"
             End Select
          Else
             GoTo NONIDENTIF
          End If
          Valor = Codigo
          Codigo = ""
          RestoCodigo = Codigo
          Exit Function
       End If
       
    NONIDENTIF:
       DescripCorta = "AI" & Mid(Codigo,1,2) & "Desconocido"
       Codigo = Mid(Codigo,3,99)
          Do while Len(Codigo) > 0
          Digitos = Digitos + 1
          C = Mid(Codigo,1,1)
          Codigo = Mid(Codigo,2,99)
          If C = Chr(29) Then
             Digitos = Digitos + 1
             Exit Do
          Else
             Valor = Valor & C
          End If
       Loop   
       RestoCodigo = Codigo 

    End If
       
    End Function

Reitero las gracias anticipadas.

Mensaje por **mauricio** » Lun Ago 15, 2016 4:41 pm

reteima escribió:Según he visto: nhttps://forum.openoffice.org/es/forum/viewtopic.php?f=50&t=10989&p=47287#p47279 tiene bastantes ineficiencias.

Si te refieres al tema enlazado, solo para aclarar, las ineficiencias que en mi experiencia he notado, reitero, solo en mi experiencia, es solo con el ciclo Do...While pero con grandes cantidades de datos, en tu código los ciclos son realmente pequeños y no vas a notar diferencia alguna... eso si, si quieres realmente mejora, usa Python...

Saludos

Mensaje por **fornelasa** » Lun Ago 15, 2016 5:59 pm

Por ejemplo, cuando un Do While "interactua" con una hoja de calculo y dentro de dicha interacción tal vez se borran filas el Do While si puede llegar a ser muy ineficiente precisamente por esa "interactuacion" , pero en este caso no hay problema y el Do While funciona aceptablemente, aun si fueran ciclos grandes (100000, 500000 .... etc)

Quitaria los SIs y los sustituiría por Select Case

Al inicio de la funcion evaluaria luego luego el Codigo así:

Código: Seleccionar todo

dato = Mid(Codigo,1,2)

Para despues usarlo más o menos así

Código: Seleccionar todo

If dato = "00" Then

Saludos, Federico.

reteima · Mensaje por **reteima** » Lun Ago 15, 2016 6:41 pm

A día de hoy no hubiera empezado con Basic, iría directamente a Python de primeras. Vergonzosamente para mí, empieza a costarme aprender cosas nuevas, lo que unido a la falta de tiempo...

Reconvertiré los If..ElseIf por Select Case y diré.

Muchas gracias por las orientaciones.

Mensaje por **SLV-es** » Mié Ago 31, 2016 7:59 pm

Para este código en particular puede ser más eficiente (no se va a notar en nada) un bucle FOR

Código: Seleccionar todo

Do while Len(Codigo) > 0
             Digitos = Digitos + 1
             C = Mid(Codigo,1,1)
             Codigo = Mid(Codigo,2,99)
             If C = Chr(29) Then
                Digitos = Digitos + 1
                Exit Do
             Else
                Valor = Valor & C
             End If
          Loop

Sustituir por

Código: Seleccionar todo

For n=1 to Len(Codigo) step 1
             Digitos = Digitos + 1
             C = Mid(Codigo,n,1)
             If C = Chr(29) Then
                Digitos = Digitos + 1
                Exit Do
             Else
                Valor = Valor & C
             End If
          next

Mejorar macro que será llamada muchas veces

Mejorar macro que será llamada muchas veces

Re: Mejorar macro que será llamada muchas veces

Re: Mejorar macro que será llamada muchas veces

Re: Mejorar macro que será llamada muchas veces

Re: Mejorar macro que será llamada muchas veces