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

    • Tu información la graficaría en función a la actividad por día
    • Hola, Observo que el planteamiento o tu formulación está mal. 1. Todos los dias deberán sumar 24:00 horas excepto el domingo que unicamente trae información hasta las 6 de la mañana. 2. Lo que observo es que esas 24:00 los componen diferentes cortes de tiempo (Columna A) 3. Creo que lo que deberás graficar son los # de casos o cuantos eventos suceden cada dia. 4. Existen algunos días que rebasan las 24 horas, por eso agregué  el formato de días. Este es el resumen. Ya me comentarás  
    • Abre un Modulo ( Alf + F11) y copia la macro, el Archivo TXT colocalo en la misma carpeta donde se encuentyre tu archivo excel. Si observas la macro, procesará el archivo 1.TXT Sub opentxt()     Application.ScreenUpdating = False     Application.DisplayAlerts = False     Range("a1:b1000").ClearContents     Dim myfile As Variant, cad As String, fila As Long     ruta = ActiveWorkbook.Path     ChDir ruta     myfile = "1.txt"     fname = Dir(myfile)     If fname = "" Then         MsgBox "No existe archivo en esta carpeta"         Exit Sub     End If          Open myfile For Input As #1     fila = 1     Cells.Clear     While Not EOF(1)         Line Input #1, cad         Cells(fila, 2) = cad         fila = fila + 1     Wend     Close #1          Application.ScreenUpdating = True     Application.DisplayAlerts = True End Sub  
    • Si me haces el favor de enviarme la macro para  intentarlo te lo agradeceré enormemente... sirve que aprendo también un poco. 
    • Buenas noches a todos los Foristas. Hola JSD, eso está PERFECTO, de hecho es más de lo que tenía pensado. Verdaderamente ustedes saben y yo trato de aprender cada día. Qué más puedo decir? Gracias mil por todo este  trabajo. Otra cosa, descuide, que si yo acudo a ustedes es porque he agotado los pocos conocimientos que tengo. Realmente sólo requiero de un ligero "empujón", un ejemplo de la duda que tengo para yo continuar con el trabajo, porque de esa manera aprendo, fijándome en el código, analizándolo y después lo desarrollo a mis necesidades. No tengo palabras para agradecerle el gesto y el trabajo realizado. Estoy en deuda con usted y porqué no, con otros miembros de este Maravilloso FORO. Doy por cerrado el tema. Un abrazo a todos y en especial a usted JSD por su paciencia y dedicación para conmigo. Nunca lo olvidaré, por eso dije en una ocasión que lo consideraba Mi Amigo, aun cuando ni siquiera nos conocemos, pero es que su comportamiento, su manera de enfocar los temas, su actitud siempre positiva y su altruismo tienen consecuencia y esa consecuencia es  decirle AMIGO. Salud y bendiciones Un abrazo. Pino
  • Recently Browsing

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

Important Information

Privacy Policy