dogwall

Por algún motivo los nombres de los títulos entre las columna 19 y 48 no los está tomando bien y mete espacios en aquellos que están formados por 2 o más palabras: ?sht.Cells(1, columna).value A.N.D.( Incluir Salud) ?seleccion A.N.D.(Incluir Salud) Una solución temporal es omitir todos los espacios a la hora de montar el array. Cambia el evento Change de tu BoxObraSoc por esto. Si te fijas sólo he modificado la línea del If para eliminar los espacios en blanco: Private Sub BoxObraSoc_Change() Dim sht As Worksheet Dim columna As Integer Dim seleccion As String, producto As String Dim arrDetelle As Variant Dim uf As Long Set sht = ThisWorkbook.Sheets("Auxiliar") uf = sht.Cells(Rows.Count, "S").End(xlUp).Row seleccion = Me.BoxObraSoc.Value For columna = 19 To 47 If Replace(seleccion, " ", "") = Replace(sht.Cells(1, columna).Value, " ", "") Then arrDetalle = sht.Range(sht.Cells(2, columna), sht.Cells(uf, columna)) End If Next columna With Me.ListAlum .Clear .List = Application.Transpose(arrDetalle) .ColumnCount = 1 .ColumnWidths = "55" End With End Sub Por cierto, en el listbox de resultados te sale siempre el valor que tienes indicado en la fila 27. Si sólo vas a tener datos útiles hasta la fila 25 cambia uf por un 25 y así evitas que en el listbox se vean al final los valores de la fila 27.

Hola, Te he montado un ejemplo sencillo. He modificado la disposición de tu tabla, para tener los tipos de producto como cabecera. Échale un ojo al fichero del enlace: https://drive.google.com/file/d/1sVOOXvM06zynkpgTLPse1Wp2hvzZQRD0/view?usp=sharing

Sube tu fichero con los datos que tienes e intento montarte un ejemplo sencillo.

Hola, por favor, sube un archivo con lo que llevas con lo que llevas hecho hasta ahora o bien copia el código de tu proyecto para que veamos por donde podemos ayudarte. Gracias.

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.

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?

De dónde sale el cálculo de la columna H?

Yo en muchas ocasiones lo que hago es abrir el fichero Excel, paso el rango de datos a un array, cierro el fichero y por último recorro el array y voy haciendo operaciones, cálculos o lo que haga falta. El recorrer el array, al estar cargado en memoria, apenas consume tiempo. En tu caso lo recorres con: For i = 1 to ubound(arRng) 'Aquí haces las operaciones que necesites. Next i

Si no hay coincidencia va a recorrer el for y va a terminar sin mostrar nada. Para que al cancelar no entre al for puedes poner un If que compruebe si x contiene un valor/texto o no y salir del procedimiento en ese caso: x = InputBox("Introducir dato a buscar", "Buscar datos") If x = "" Then Exit Sub