Visual Basic para Aplicaciones - Agregar conteo a una celda con datos

Life is soft - evento anual de software empresarial
 
Vista:
sin imagen de perfil
Val: 13
Ha aumentado su posición en 4 puestos en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Agregar conteo a una celda con datos

Publicado por David (6 intervenciones) el 06/02/2019 13:51:52
Hola gente! tengo un problemilla con mi código y me ha tomado unos días, pero aun no puedo solucionarlo..
lo principal que hace es arrojar una CANTIDAD en un rango de celdas. Si una celda llega a 7 (este 7 representa espacios disponibles) pasa a la celda siguiente a la izquierda y asi hasta completar el total de la cantidad. adicional a eso coloca un CODIGO en la parte inferior de las celdas llenadas para su identificación..
El problema y lo que no he podido hacer, es que necesito que al ingresar otra cantidad ésta comience de donde terminó la anterior (esto lo hace el código), y si por ejemplo no hubiese completado los 7 espacios de la celda, que comience desde el espacio que quedo, pero poniendo la cantidad indicada mas la anterior y no sobreescribiéndola, para que si yo pongo por ejemplo dos veces la cantidad 8 , esta se guarde en las celdas con un maximo de 7 por celda, pero en el total del rango existan 16 cantidades.
Aqui va el codigo, unas fotos y el archivo para que puedan ver como funciona la macro
De antemano muchas gracias !

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
Sub iniciar()
' se insertan variables
Dim cantidad, codigo As Integer
Dim contador, auxiliar As String
Dim verif As Range
Set verif = Range("F2:A2")
contador = Cells(2, 7).Value
auxiliar = 0
cantidad = Cells(11, 2).Value
codigo = Cells(11, 4).Value
fila = 2
columna = 6 - contador
ultimo = 0 ' valida que la ultima celda sea el auxiliar
' se termina de insertar variables
 
' verificacion de posicion
For Each cell In verif
    If cell < 7 And cell > 0 Then
            ActiveSheet.Cells(fila, 8) = cell.Value
            auxiliar = ActiveSheet.Cells(fila, 8)
            columna = columna + 1
       Exit For
    Else
            ActiveSheet.Cells(fila, 8) = 0
            ' columna = columna
    End If
Next cell
 
' contador de apilamiento
 
    For n = 1 To cantidad
 
        contador = Cells(2, 7).Value
        If ultimo = 0 Then
            If n < 8 Then
                If auxiliar > 0 Then
                    ActiveSheet.Cells(fila, columna) = n  ' se agrega la cantidad
                    ActiveSheet.Cells(fila + 1, columna) = codigo  'se agrega el codigo debajo de cada cantidad
 
                Else
                    ActiveSheet.Cells(fila, columna) = n  ' se agrega la cantidad
                    ActiveSheet.Cells(fila + 1, columna) = codigo  'se agrega el codigo debajo de cada cantidad
                End If
 
            Else
                columna = 6 - contador
 
                If cantidad > 6 Then
                    cantidad = cantidad - 7
 
                        If cantidad < 7 Then
                            ultimo = 1
                            aux = cantidad
 
                        End If
                End If
                n = 0
 
            End If
        Else
            If n <= aux Then
                ActiveSheet.Cells(fila, columna) = n ' se agrega la cantidad
                ActiveSheet.Cells(fila + 1, columna) = codigo  ' se agrega el codigo debajo de cada cantidad
            End If
        End If
    Next n
 
 
End Sub

2019_02_06_09_28_52_final_ocean_presentacion.xlsm_Excel
2019_02_06_09_29_36_final_ocean_presentacion.xlsm_Excel
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder
Imágen de perfil de MIGUEL
Val: 424
Bronce
Ha mantenido su posición en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Agregar conteo a una celda con datos

Publicado por MIGUEL (121 intervenciones) el 07/02/2019 20:47:44
En la celda del contador use esta formula:=CONTARA(A2:F2),en la celda del auxiliar use esta formula:CONTAR.BLANCO(A2:F2)
No me quedo muy claro para que usas el auxiliar. pero la macro imprime los valores deacuerdo a la cantidad que indiques sin cambiar los valores despues pones otra cantidad y ocupa las celdas faltantes dentro del rango sin sobre-escribir y sin importar la cantidad que le pongas solo ocupa las celdas disponibles en el rango.



1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Sub MACRO1()
    Dim CONT As Long
    Dim aux As Long
    Dim cant As Long
    Dim cod As Long
    CONT = Hoja1.Range("G2").Value
    aux = Hoja1.Range("H2").Value
    cant = Hoja1.Range("B11")
    If cant <= CONT Then
        CONT = 0
    End If
    cod = Hoja1.Range("D11")
    Do While CONT < cant
        If aux = 0 Then
            Exit Do
        End If
        Hoja1.Cells(2, aux) = cant
        Hoja1.Cells(3, aux) = cod
        CONT = CONT + 1
        aux = aux - 1
    Loop
 
End Sub

las variables estan en long para el ejemplo que pones es suficiente con declararlas como byte solo cod seria long ya que byte mandaria un desbordamiento.

Saludos
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar
Imágen de perfil de MIGUEL
Val: 424
Bronce
Ha mantenido su posición en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Agregar conteo a una celda con datos

Publicado por MIGUEL (121 intervenciones) el 08/02/2019 04:02:53
creo que ya entendí jajajaja, perdón mi amigo pero la verdad no logro tener una idea clara de lo que quieres hacer, a ver si le atine con esta

utilizo las mismas formulas que en la otra macro

Esta macro es para insertar un registro por cada click sin sobre-escribir y en la celda continua a la izquierda mientras haya celdas disponibles en el rango establecido por la formula en auxiliar.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub MACRO2()
    Dim CONT As Long
    Dim aux As Long
    Dim cant As Long
    Dim cod As Long
    CONT = 0
    aux = Hoja1.Range("H2").Value
    cant = Hoja1.Range("B11")
    cod = Hoja1.Range("D11")
    Do While CONT < 1
        If aux = 0 Then
            MsgBox "Ya no hay espacios disponibles!", vbOKOnly + vbCritical, "SIN ESPACIO"
            Exit Do
        End If
        Hoja1.Cells(2, aux) = cant
        Hoja1.Cells(3, aux) = cod
        CONT = CONT + 1
    Loop
End Sub
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar
Imágen de perfil de MIGUEL
Val: 424
Bronce
Ha mantenido su posición en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Agregar conteo a una celda con datos

Publicado por MIGUEL (121 intervenciones) el 08/02/2019 05:37:44
La tercera es la vencida

Ya sin con esta no te ayudo me doy por vencido

Las mismas formulas que en las anteriores

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
Sub MACRO3()
    Dim CONT As Long
    Dim largo As Byte
    Dim compLargo As Byte
    Dim colum As Byte
    Dim aux As Long
    Dim cant As Long
    Dim cod As String
    CONT = 0
    aux = Hoja1.Range("H2").Value
    cant = Hoja1.Range("B11")
    cod = Hoja1.Range("D11")
    colum = 6
    largo = 13
    Do While CONT < 1
        Do While colum <> 0
            compLargo = Len(Hoja1.Cells(2, colum))
            If Hoja1.Cells(2, colum) = "" And aux <> 0 Then
                Hoja1.Cells(2, aux) = cant
                Hoja1.Cells(3, aux) = cod
                colum = 0
            ElseIf Hoja1.Cells(3, colum) = cod And compLargo < largo Then
                Hoja1.Cells(2, colum) = Hoja1.Cells(2, colum) & "+" & cant
                colum = 0
            ElseIf Hoja1.Cells(3, colum) = cod And compLargo = largo Then
                MsgBox "Ya no se puede sumar este codigo!"
                colum = 0
            Else
                colum = colum - 1
            End If
        Loop
        CONT = CONT + 1
    Loop
 
End Sub


Saludos
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar
sin imagen de perfil
Val: 13
Ha aumentado su posición en 4 puestos en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Agregar conteo a una celda con datos

Publicado por David (6 intervenciones) el 08/02/2019 13:10:36
Gracias por tus respuestas !!
probare los codigos ahora porque no pude antes, cualquier cosa te aviso, pero muchas gracias por tu tiempo :)
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil
Val: 13
Ha aumentado su posición en 4 puestos en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Agregar conteo a una celda con datos

Publicado por David (6 intervenciones) el 08/02/2019 13:44:32
Estimado, lamentablemente no me pudo ayudar :(
la idea es buena, pero en cada celda no se pueden superar las 7 unidades, por eso cuando llega a 7 se va a la celda de la izquierda y comienza a llenar esos espacios hasta 7 nuevamente.

el problema se genera cuando por ejemplo, pongo la cantidad de 8 se debe llenar la primera celda (columna 6) hasta la cantidad de 7 y luego se pasa a la celda siguiente con la cantidad de 1 -----> esto esta correcto y lo hace mi código.

pero cuando vuelvo a poner otra cantidad, como por ejemplo 8 nuevamente, este debería rellenar la celda que quedo con 1 unidad guardada, llegando a las 7 y luego cambiar a la otra celda para seguir llenando, que en este caso debería quedar con 2, sumando así en total los las 16 unidades que ingrese. ----> esto es lo que quiero que haga el código y que no puedo lograr :c

muchas gracias por tu tiempo y tus ganas de ayudar !
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de MIGUEL
Val: 424
Bronce
Ha mantenido su posición en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Agregar conteo a una celda con datos

Publicado por MIGUEL (121 intervenciones) el 08/02/2019 17:13:54
mismas formulas

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Sub MACRO2()
    Dim CONT As Long
    Dim tope As Long
    Dim aux As Long
    Dim aux2 As Long
    Dim i As Long
    Dim cant As Long
    Dim cant2 As Long
    Dim cod As Long
    CONT = 0
    aux = Hoja1.Range("H2").Value
    aux2 = aux
    cant = Hoja1.Range("B11")
    cod = Hoja1.Range("D11")
    tope = 7
    i = 1
    Do While CONT < 1
        If aux = 0 Then
            MsgBox "Ya no hay espacios disponibles!", vbOKOnly + vbCritical, "SIN ESPACIO"
            Exit Do
        End If
        If cant > tope Then
            Hoja1.Cells(2, aux) = tope
            Hoja1.Cells(3, aux) = cod
            CONT = 0
            aux2 = aux - i
            cant2 = cant - tope
            cant = cant - tope
        ElseIf cant <= tope Then
            Hoja1.Cells(2, aux) = cant
            Hoja1.Cells(3, aux) = cod
            CONT = 1
            aux2 = aux - i
            cant2 = cant - tope
            cant = cant - tope
        ElseIf cant <= tope And cant > 0 Then
        Hoja1.Cells(2, aux2) = cant2
        Hoja1.Cells(3, aux2) = cod
        CONT = 0
        aux2 = aux2 - 1
        cant = cant - cant2
            If aux = 0 Then
                Exit Do
            End If
        CONT = CONT + 1
        End If
        'CONT = CONT + 1
        aux = aux - 1
    Loop
End Sub

Saludos
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil
Val: 13
Ha aumentado su posición en 4 puestos en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Agregar conteo a una celda con datos

Publicado por David (6 intervenciones) el 08/02/2019 18:32:11
aun no :(
no esta rellenando los puestos que faltan de las celdas incompletas, en lugar de hacer eso se salta de inmediato a otra celda, dejando puestos sin llenar

si se pone una cantidad menor a 7, de todas formas se salta a otra celda y deja 2 puestos sin llenar.

Muchas gracias por tu tiempo y tus respuestas. creo que me tomara mas tiempo del esperado conseguir lo que quiero jajaj saludos
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de MIGUEL
Val: 424
Bronce
Ha mantenido su posición en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Agregar conteo a una celda con datos

Publicado por MIGUEL (121 intervenciones) el 09/02/2019 02:29:56
si, jajaja, tengo una duda, quieres que al ingresar el primer codigo con 8 de cantidad en la sexta columna ponga 7 y en la quinta ponga 1 que seria lo que le sobro de la cantidad, si pones otro codigo con la cantidad 5 por ejemplo esta cantidad la pondria en la cuarta columna?, y si pones de nuevo el primer codigo con la cantidad 8 ponga en la columna 5 el numero 7 y en la tercera columna ponga un 2 que seria lo que sobra de la suma de ambas cantidades que se ingresaron para el primer codigo? , y asi hasta quedar sin columnas?
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de MIGUEL
Val: 424
Bronce
Ha mantenido su posición en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Agregar conteo a una celda con datos

Publicado por MIGUEL (121 intervenciones) el 09/02/2019 15:26:09
Si es asi como te digo esta es la macro que lo hace

solo tienes que recorrer una columna el rango de celdas para que quede la columna A en blanco

con las mismas formulas pero en auxiliar sumale 1 (=CONTAR.BLANCO(B2:G2)+1)


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
Sub Macro4()
    Dim CONT As Long
    Dim cont2 As Long
    Dim largo As Byte
    Dim colum As Byte
    Dim aux As Long
    Dim cant As Long
    Dim cant2 As Long
    Dim cod As String
    Dim tope As Long
    Dim colum2 As Long
    Dim i As Long
    CONT = 0
    cont2 = Hoja1.Range("H2").Value
    aux = Hoja1.Range("I2").Value
    cant = Hoja1.Range("C11")
    cod = Hoja1.Range("E11")
    colum = 7
    colum2 = 7
    largo = 13
    tope = 7
    i = 1
    Do While CONT < 1
        If aux = 1 And Hoja1.Cells(2, 2) = 7 Then
            MsgBox "Ya no hay espacios disponibles!", vbOKOnly + vbCritical, "SIN ESPACIO"
            Exit Sub
        End If
        Do While colum <> 0
            If cant > tope And Hoja1.Cells(2, 7) = "" Then
                Hoja1.Cells(2, 7) = tope
                Hoja1.Cells(3, 7) = cod
                cant = cant - tope
                colum = colum - i
 
            ElseIf cant <= tope And Hoja1.Cells(2, 7) = "" Then
                Hoja1.Cells(2, 7) = cant
                Hoja1.Cells(3, 7) = cod
                colum = 0
            ElseIf (cant <= tope Or cant >= tope) And Hoja1.Cells(2, 7) <> "" Then
                Do While colum2 <> 0
                    If aux = 1 And cant > tope Then
                        MsgBox "Ya no hay espacio!"
                        Exit Sub
                    End If
                    If Hoja1.Cells(2, colum2) = tope And Hoja1.Cells(3, colum2) = cod Then
                        colum2 = colum2 - 1
                    ElseIf Hoja1.Cells(2, colum2) = tope And Hoja1.Cells(3, colum2) <> cod Then
                        colum2 = colum2 - 1
                    ElseIf Hoja1.Cells(2, colum2) < tope And Hoja1.Cells(3, colum2) <> cod And Hoja1.Cells(2, aux) = "" Then
                            If Hoja1.Cells(2, colum2).Offset(0, -1) <> "" Then
                                colum2 = colum2 - 1
                            ElseIf cant <= tope Then
                                Hoja1.Cells(2, aux) = cant
                                Hoja1.Cells(3, aux) = cod
                                colum2 = 0
                                colum = 0
                            Else
                                Hoja1.Cells(2, aux) = tope
                                Hoja1.Cells(3, aux) = cod
                                colum2 = aux
                                cant = cant - tope
                            End If
                    ElseIf Hoja1.Cells(2, colum2) < tope And Hoja1.Cells(3, colum2) = cod And cant > tope Then
                        cant2 = Hoja1.Cells(2, colum2)
                        Hoja1.Cells(2, colum2) = tope
                        colum2 = colum2 - 1
                        cant = (cant - tope) + cant2
                    ElseIf (Hoja1.Cells(2, colum2) < tope Or Hoja1.Cells(2, colum2) = "") And Hoja1.Cells(3, colum2) = cod And (Hoja1.Cells(2, colum2) + cant) <= tope Then
                        Hoja1.Cells(2, colum2) = Hoja1.Cells(2, colum2) + cant
                        colum2 = 0
                        colum = 0
                    ElseIf (Hoja1.Cells(2, colum2) < tope Or Hoja1.Cells(2, colum2) = "") And Hoja1.Cells(3, colum2) <> cod And (Hoja1.Cells(2, colum2) + cant) <= tope Then
                        Hoja1.Cells(2, colum2) = cant
                        Hoja1.Cells(3, colum2) = cod
                        colum2 = 0
                        colum = 0
                    ElseIf (Hoja1.Cells(2, colum2) < tope Or Hoja1.Cells(2, colum2) = "") And Hoja1.Cells(3, colum2) = cod And (Hoja1.Cells(2, colum2) + cant) > tope Then
                        cant2 = Hoja1.Cells(2, colum2)
                        Hoja1.Cells(2, colum2) = tope
                        colum2 = colum2 - 1
                        cant = (cant + cant2) - tope
                    ElseIf (Hoja1.Cells(2, colum2) < tope Or Hoja1.Cells(2, colum2) = "") And Hoja1.Cells(3, colum2) <> cod And (Hoja1.Cells(2, colum2) + cant) > tope Then
                        Hoja1.Cells(2, colum2) = tope
                        Hoja1.Cells(3, colum2) = cod
                        colum2 = colum2 - 1
                        cant = cant - tope
                    Else
                        MsgBox "algo anda mal"
                        colum2 = 0
                        colum = 0
                    End If
                Loop
                If aux = 1 Then
                    Exit Sub
                End If
            Else
                colum = colum - 1
            End If
            DoEvents
        Loop
        CONT = CONT + 1
    Loop
 
End Sub

Saludos
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil
Val: 13
Ha aumentado su posición en 4 puestos en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Agregar conteo a una celda con datos

Publicado por David (6 intervenciones) el 11/02/2019 13:32:47
Disculpa por no poder responder antes !!!

Mira, imagina que las celdas son posiciones de una bodega, donde cada posición se pueden apilar 7 cajas hacia arriba como máximo, donde da lo mismo si tienen códigos distintos.

Por lo tanto, si la bodega esta vacía, se deben ingresar las cajas de manera ordenada sin saltarse posiciones dentro de la bodega, por lo que si ponemos primeramente 15 unidades, las primeras dos columnas se llenarían con 7 cada una y la tercera columna quedaría con 1 unidad. (15 en total)

Si hacemos otro ingreso a la bodega de 8 unidades, la tercera columna que tenia una unidad del código pasado, quedaría ahora con 7 unidades (1 del anterior y 6 del nuevo ingreso con nuevo código), y la cuarta columna tendría que quedar con 2 unidades....

y así sucesivamente hasta que todas las columnas se llenen con 7 unidades apiladas.

Cabe destacar que si en una columna, como por ejemplo en la tercera columna del ejemplo que di recién, tienen cajas con códigos diferentes, es necesario que en la celda de abajo donde se muestra el código, queden plasmados los dos códigos separados con una barra ( / ) *( no se da en la realidad que queden mas de dos codigos en una columna)*

muchas gracias !!
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
Imágen de perfil de MIGUEL
Val: 424
Bronce
Ha mantenido su posición en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Agregar conteo a una celda con datos

Publicado por MIGUEL (121 intervenciones) el 11/02/2019 17:29:21
CON LAS POSICIONES QUE TENIAMOS AL PRINCIPIO Y LAS FORMULAS DE LA MACRO 1


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
Sub macro5()
    Dim CONT As Long
    Dim colum As Byte
    Dim aux As Long
    Dim cant As Long
    Dim cant2 As Long
    Dim cod As String
    Dim tope As Long
    Dim colum2 As Long
    CONT = 0
    aux = Hoja1.Range("H2").Value
    cant = Hoja1.Range("B11")
    cod = Hoja1.Range("D11")
    colum = 6
    colum2 = 6
    tope = 7
    Do While CONT < 1
        If aux = 0 And Hoja1.Cells(2, 1) = 7 Then
            MsgBox "Ya no hay espacios disponibles!", vbOKOnly + vbCritical, "SIN ESPACIO"
            Exit Sub
        End If
        Do While colum <> 0
            If cant > tope And Hoja1.Cells(2, 6) = "" Then
                Hoja1.Cells(2, 6) = tope
                Hoja1.Cells(3, 6) = cod
                cant = cant - tope
                colum = colum - 1
 
            ElseIf cant <= tope And Hoja1.Cells(2, 6) = "" Then
                Hoja1.Cells(2, 6) = cant
                Hoja1.Cells(3, 6) = cod
                colum = 0
            ElseIf (cant <= tope Or cant >= tope) And Hoja1.Cells(2, 6) <> "" Then
                Do While colum2 <> 0
                    If aux = 0 And cant > tope Then
                        MsgBox "Ya no hay espacio!"
                        Exit Sub
                    End If
                    If Hoja1.Cells(2, colum2) = tope And Hoja1.Cells(3, colum2) = cod Then
                        colum2 = colum2 - 1
                    ElseIf Hoja1.Cells(2, colum2) = tope And Hoja1.Cells(3, colum2) <> cod Then
                        colum2 = colum2 - 1
                    ElseIf Hoja1.Cells(2, colum2) < tope And Hoja1.Cells(3, colum2) = cod And (Hoja1.Cells(2, colum2) + cant) <= tope Then
                        Hoja1.Cells(2, colum2) = Hoja1.Cells(2, colum2) + cant
                        colum2 = 0
                        colum = 0
                    ElseIf Hoja1.Cells(2, colum2) < tope And Hoja1.Cells(3, colum2) <> cod And (Hoja1.Cells(2, colum2) + cant) <= tope Then
                        If Hoja1.Cells(3, colum2) = "" Then
                            Hoja1.Cells(2, colum2) = Hoja1.Cells(2, colum2) + cant
                            Hoja1.Cells(3, colum2) = cod
                            colum2 = 0
                            colum = 0
                        Else
                            Hoja1.Cells(2, colum2) = Hoja1.Cells(2, colum2) + cant
                            Hoja1.Cells(3, colum2) = Hoja1.Cells(3, colum2) & "/" & cod
                            colum2 = 0
                            colum = 0
                        End If
                    ElseIf Hoja1.Cells(2, colum2) < tope And Hoja1.Cells(3, colum2) = cod And (Hoja1.Cells(2, colum2) + cant) > tope Then
                        cant2 = Hoja1.Cells(2, colum2)
                        Hoja1.Cells(2, colum2) = tope
                        colum2 = colum2 - 1
                        cant = (cant + cant2) - tope
                    ElseIf Hoja1.Cells(2, colum2) < tope And Hoja1.Cells(3, colum2) <> cod And (Hoja1.Cells(2, colum2) + cant) > tope Then
                        If Hoja1.Cells(3, colum2) = "" Then
                        cant2 = Hoja1.Cells(2, colum2)
                        Hoja1.Cells(2, colum2) = tope
                        Hoja1.Cells(3, colum2) = cod
                        colum2 = colum2 - 1
                        cant = (cant + cant2) - tope
                    Else
                        cant2 = Hoja1.Cells(2, colum2)
                        Hoja1.Cells(2, colum2) = tope
                        Hoja1.Cells(3, colum2) = Hoja1.Cells(3, colum2) & "/" & cod
                        colum2 = colum2 - 1
                        cant = (cant + cant2) - tope
                    End If
                    Else
                        MsgBox "algo anda mal"
                        colum2 = 0
                        colum = 0
                    End If
                Loop
                If aux = 1 Then
                    Exit Sub
                End If
            Else
                colum = colum - 1
            End If
            DoEvents
        Loop
        CONT = CONT + 1
    Loop
 
End Sub


SALUDOS
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
1
Comentar
sin imagen de perfil
Val: 13
Ha aumentado su posición en 4 puestos en Visual Basic para Aplicaciones (en relación al último mes)
Gráfica de Visual Basic para Aplicaciones

Agregar conteo a una celda con datos

Publicado por David (6 intervenciones) el 11/02/2019 19:03:50
este si, hace todo !!! muchas gracias por tu tiempo :DDD
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar