Jump to content

Recommended Posts

Buenas noches.

Estimados es para pedirle su apoyo en optimizar mi trabajo, explicó en el adjunto y también quiero agradecer el apoyo de cada uno de ustedes, del esfuerzo y la dedicación que le ponen al contribuir sus conocimientos incondicionalmente.

Saludos.

P543a.xlsm

Link to comment
Share on other sites

En 2/8/2021 at 21:50 , fredycayo dijo:

Buenas noches.

Estimados es para pedirle su apoyo en optimizar mi trabajo, explicó en el adjunto y también quiero agradecer el apoyo de cada uno de ustedes, del esfuerzo y la dedicación que le ponen al contribuir sus conocimientos incondicionalmente.

Saludos.

 

P543a.xlsm 33.77 kB · 2 descargas

Buen día,

Agradezco por el tiempo, es valor de la columna A

BF1...

PC1...

PRD...

PDR..

Link to comment
Share on other sites

En 5/8/2021 at 19:55 , fredycayo dijo:

Buen día,

Agradezco por el tiempo, es valor de la columna A

BF1...

PC1...

PRD...

PDR..

Hola, 

Todo lo que empieza por B es 0,2? ¿Todo lo que comienza por PC es 0,6? ¿Habría más valores aparte de los que aparecen en tu ejemplo?

Link to comment
Share on other sites

Muy buenas tardes. si Rampa= RP Las rampas tiene una inclinación por porcentajes y estos no son fijos y cambian constantemente desde 1 cm hasta los 6 mts. solo quiero trabajar con los que tienen valores fijos.

Agradezco su tiempo.

Saludos.

Link to comment
Share on other sites

Hola, 

Iba a subir tu archivo con el código que he añadido, pero no tengo claro cómo hacerlo.  De todas formas te explico:

Añade esta función a tú código, en cualquier módulo (está sacada de StackOverflow) que sirve para extraer números de una cadena de texto:

Function onlyDigits(s As String) As String
    ' Variables needed (remember to use "option explicit").   '
    Dim retval As String    ' This is the return string.      '
    Dim i As Integer        ' Counter for character position. '

    ' Initialise return string to empty                       '
    retval = ""

    ' For every character in input string, copy digits to     '
    '   return string.                                        '
    For i = 1 To Len(s)
        If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Then
            retval = retval + Mid(s, i, 1)
        End If
    Next

    ' Then return the return string.                          '
    onlyDigits = retval
End Function

Ahora añade este módulo, que es el que hace todo el trabajo:

Sub calcular()

    Dim i As Long, uf As Long, x As Long
    Dim sht As Worksheet
    Dim cota As Double, profundidad As Double
    Dim calculoH As String, calculoI As Double, TipoValor As Double
    Dim calculoG As Integer
    Dim NPunto As String
    Dim arrDatos As Variant, arrReport As Variant
        
    Set sht = ThisWorkbook.Sheets("Hoja1")
    uf = sht.Cells(Rows.Count, "A").End(xlUp).Row
    arrDatos = sht.Range("A2:D" & uf)
    
    sht.Range("N2:S" & uf).ClearContents
    
    ReDim arrReport(0 To UBound(arrDatos), 5)
    x = 0
    For i = 1 To UBound(arrDatos)
    
        calculoH = Left(arrDatos(i, 1), 2)
    
        Select Case calculoH
        
        Case Is = "BF": TipoValor = 0.2
        Case Is = "PC": TipoValor = 0.6
        Case Is = "PR": TipoValor = 0.8
        Case Is = "PD": TipoValor = 0.8
                
        End Select
        
        NPunto = arrDatos(i, 1)
        arrReport(x, 0) = onlyDigits(NPunto)    'Nº de Punto
        arrReport(x, 1) = arrDatos(i, 2)        'ESTE
        arrReport(x, 2) = arrDatos(i, 3)        'NORTE
        arrReport(x, 3) = arrDatos(i, 4)        'COTA
        calculoG = Application.WorksheetFunction.Round(arrDatos(i, 4), 0) - 6
        calculoI = arrDatos(i, 4) - (CInt(calculoG) - TipoValor)
        arrReport(x, 4) = calculoI              'PROFUNDIDAD
        arrReport(x, 5) = arrDatos(i, 1)        'CODIGO
        x = x + 1
        
    Next i

    sht.Range("N2").Resize(UBound(arrReport), 6) = arrReport

End Sub

Y por último asocia tú botón "Cálculo"  a esa macro (calcular). La macro borra el rango N2:S & ultima fila y añade los cálculos en base a tu tabla.

Saludos.

 

Link to comment
Share on other sites

  • Crear macros Excel

  • Posts

    • Simplemente pon Tema Solucionado, aunque luego si me da tiempo lo miro
    • Estimados buenos días, En vista de que no sé como eliminar este tema que inicié, les informo que ya pude solucionar el problema, la única solución que pude darle fue realizar las ejecuciones por tiempo, es decir que primero me importe la información que contenga coincidencias entre ambas hojas, me realice los cálculos y luego envíe la información a las hojas correspondientes, luego importa la información que no tienen coincidencia y ahí no realiza ningún cálculo ya que no hay información, entonces esa información la pasa a las hojas respectivas. Lo estuve probando y funciona sin problemas, adjunto el Excel (Macro - Presupuesto) para que puedan revisarlo y si hay alguna otra sugerencia quedaría agradecido para poder ampliar mis conocimientos con respecto a todo este mundo de las Macros, Muchas gracias por su tiempo y disculpen los inconvenientes. Saludos cordiales
    • Muchas gracias a los dos. Ambas respuestas me han servido, pero por sencillez he optado por la de JSDJSD. No obstante, como comenté anteriormente, tengo que tener siempre activa una impresora (de tickets) entonces si le doy a la macro, al crearse el PDF lo hace en el formato de esa impresora. Por tanto, pensé en el inicio de ejecutar la macro poner:  Application.ActivePrinter = "Microsoft Print to PDF" Y una vez finalizada la macro, cambiar a la impresora de Tickets, pero me da error. ¿Hay alguna forma de conseguir esto que comento? Gracias.
    • Ya puedes descargar un Test de Excel, hecho con el cálculo iterativo de las fórmulas de Excel.¡Mentira!¡No lo vas a poder descargar!He incrustado el test en mi blog, y sólo vas a poder realizar el test en modo online, desde un navegador Web o con una tableta o un móvil Android o Mac.   Enlace aquí:https://pedrowave.blogspot.com/2021/10/test-de-excel-con-calculo-iterativo.html     Ventajas de tener el Test de Excel en la nube: No contiene macros VBA ni Office Script. Se actualiza automáticamente al ser un Excel en la Web. Siempre verás la versión más actualizada del Test. Todos los usuarios harán el Test en las mismas condiciones. Se puede hacer el Test en la nube, incluso sin tener Excel instalado. Puedes hacer comentarios al Test en la nube. Puedo actualizar el Test cuando quiera para añadir más preguntas. Puedo modificar su comportamiento, mejorar su uso y/o corregir errores. Puedo proteger mucho mejor mis derechos de autor, para que no se pueda copiar mi idea de este Test de Excel. Gracias anticipadas por seguirme, por tus reacciones y por tus comentarios.
  • Recently Browsing

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

Important Information

Privacy Policy