Jump to content

dogwall

Members
  • Posts

    162
  • Joined

  • Last visited

Posts posted by dogwall

  1. Hace 5 horas, lsmaniahotmail.com dijo:

    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.

     

  2. Hace 2 horas, lsmaniahotmail.com dijo:

    Hola gracias por querer , ayudar ,mira solo tengo la hoja 1 con la tabla de llenada con seccion y sus prouctos + un boton que llama al formulario que solo tiene el combobox y el cuadro de lista que , es la programacion que me hace falta para llenarlo.¿ seria mas conveniente cambiar la dispocion de la tabla , por ej que figuren encabezados con los nombres de la secciones y luego desarrollo el listado de los productos por cada columna?, seria mas conveniente creo , en definitiva en cualquiera de los dos casos como seria el cod?

    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

  3. 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.

     

  4. 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?

  5. 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

     

×
×
  • Create New...

Important Information

Privacy Policy