publicado el 3 de agosto3 años 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
publicado el 5 de agosto3 años Autor 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..
publicado el 9 de agosto3 años 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?
publicado el 9 de agosto3 años Autor 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.
publicado el 10 de agosto3 años 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.
publicado el 10 de agosto3 años Autor Estimado Dogwall. Muy agradecido por tu atención a mi problema funciona perfectamente, solucionado
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