Saltar al contenido
Te enseño 7 de los trucos que me permitieron trabajar 2 horas menos al día >>>

Correcto cierre de un ciclo en la macro

segalo

Por segalo
en Macros y programación VBA

Recommended Posts

segalo Novato

segalo

publicado
publicado

Buen dia 

Recuerro a ustedes papar poder validar el correcto cierre del ciclo de esta macro.

El ciclo afectado es el FOR que tiene la variable n debe trabajar hasta el 23, pero cuando llega a 24, sigue con el ciclo de numero1 y de suma y continua trabajando con errores.

como puedo hacer para que la n al llegar a 24 finalice la macro y no realice las demas actividades  ? ya movi los Next pero no lo he logrado, espero me puedan dar una guia 

Gracias 

 

esta es la macro

 

Sub Union()
'
Dim fila, RR As Long

Dim n&, cCriterio$, H&, g&, y&

   fila = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row

    j = 5
   y = 1
    
  For H = 5 To 23
    
    Dim aCol, t&, LE$
    aCol = Array("E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y")
    For t = LBound(aCol) To UBound(aCol)
    LE = aCol(t)
    

For n = j To 23
        If n = j Then cCriterio = "<>0" Else cCriterio = "0"
        ActiveSheet.Range("$A$11:$AH$" & fila).AutoFilter Field:=n, Criteria1:=cCriterio
   
           ' numero1
    Range("A12").Select
    ActiveCell.FormulaR1C1 = y
    Range("B12").Select
    Selection.End(xlDown).Select
    Range("A" & fila).Select
    ActiveCell.FormulaR1C1 = y
    Range("A" & fila).Select
    Selection.Copy
    Range(Selection, Selection.End(xlUp)).Select
    Selection.Resize(Selection.Rows.Count + 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.End(xlUp).Select
    ActiveWindow.SmallScroll Down:=-24
    
    RR = fila - 11
    
    'MsgBox RR
    
     'suma
        Range(LE & 10).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(LE & 11).Select
    Selection.End(xlDown).Select
    Range(LE & fila).Select
    Application.CutCopyMode = False
   ActiveCell.Formula = "=SUBTOTAL(9," & LE & "12:" & LE & Selection.Row - 1 & ")"
    Range(LE & fila).Select
    Selection.Copy
    Selection.End(xlUp).Select
    Range(LE & 9).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
         
           Next n


    j = j + 1
    n = j
    y = y + 1

    Rows("11:11").Select
    ActiveSheet.ShowAllData
    Range("A10").Select
        
            Next t
          Next H

End Sub

 

 

Gracias 

Ciclo.xlsm

Leopoldo Blancas Novato

Leopoldo Blancas

publicado
publicado

Hola,

Gastando mis últimos 20 centavos...

No entiendo lo que quieres hacer con la macro, a lo mejor tienes código innecesario, con esos datos en otra hoja pon como quieres que sea el resultado a mano... Ya que tu macro esta hecha camotes...

Por ejemplo tienes este código:

    For H = 5 To 23
        aCol = Array("E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y")
        For t = LBound(aCol) To UBound(aCol)
            LE = aCol(t)
            'MsgBox LE
            For n = j To 23
                If n = j Then cCriterio = "<>0" Else cCriterio = "0"
                ActiveSheet.Range("$A$11:$AH$" & fila).AutoFilter Field:=n, Criteria1:=cCriterio
            Next n
    

Lo que puse en negritas cambia el FILTRO de 5 a 23 veces y no hace nada ese código en concreto....

Etc, etc, etc, con el demás código.

y una buena explicación en la nueva hoja resuelta a mano....

Saludos.

P.D.: APROVECHA ANTES DE GASTAR ESOS 20 CENTAVOS.
 

 

 

 

segalo Novato

segalo

publicado
  • Autor
publicado

Gracias Leopoldo 

El tema del ciclo de n hasta 23 es el centro de la macro, lo que realiza es filtrar los valores de la columna de la letra LE con los valores diferentes a cero y las demas en cero, y asi en cada ciclo ya corriendo a la derecha y debe numerar en la columna A en que ciclo queda cada linea y saca la sumatoria al final, si eejcutas la macro vas a ver el resultado en la columna A y  en la fila 9 

 

Gracias 

Leopoldo Blancas Novato

Leopoldo Blancas

publicado
publicado

Hola,

No puedo seguir tu código... A lo mejor en tu cabecita esta claro, pero para mi no.

Hace 14 horas, Leopoldo Blancas dijo:

For n = j To 23
                If n = j Then cCriterio = "<>0" Else cCriterio = "0"
                ActiveSheet.Range("$A$11:$AH$" & fila).AutoFilter Field:=n, Criteria1:=cCriterio
            Next n

Si te fijas en este código al final siempre va a quedar filtrado por la columna 23, y no me queda claro el propósito de ello.

Y no se como salen las cantidades de la fila 9...

Si podrías explicarlo paso por paso lo que haces o quieres hacer? Seria de gran ayuda, para gastar estos últimos 20 centavos que me quedan...

NOTA: DONDE DA ERROR LA MACRO SUSTITÚYELO POR:

If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData

 

Saludos

segalo Novato

segalo

publicado
  • Autor
publicado

 

Exacto Leopoldo 

al final cuando realiza la 23 realiza su proceso ok, pero cuando cambia a 24 ya no cambia de columna y continua con el bloque de numero1 y la suma, ese es el error.

el error lo da, al momento que como no tiene filtro, le pido que desactive los filtros y saca el error.

yo que requiero es que cuando haga el ciclo del 23 finalize la macro, ya no haga nada mas, como podria hacer eso ? 

 

 

Gracias 

 

 

 

segalo Novato

segalo

publicado
  • Autor
publicado

 

Lo siento, por no darme a entender, si ejecutan la macro veran que fianliza en error, ya que cuando la variable n llega a 24, continua con tareas, yo requiero que nunca llegue a 24 o bueno que esas tareas no se ejecuten adicionales, y termine en error

 

o me podrian preguntar que parte excta no entienden 

 

Gracias 

 

 

 

Gerson Pineda Mentor

Gerson Pineda

publicado
publicado

Hola segalo

En 14/12/2019 at 20:15 , segalo dijo:

Buen dia 

Recuerro a ustedes papar poder validar el correcto cierre del ciclo de esta macro.

El ciclo afectado es el FOR que tiene la variable n debe trabajar hasta el 23, pero cuando llega a 24, sigue con el ciclo de numero1 y de suma y continua trabajando con errores.

como puedo hacer para que la n al llegar a 24 finalice la macro y no realice las demas actividades  ? ya movi los Next pero no lo he logrado, espero me puedan dar una guia 

Gracias 

Para entenderte mucho mejor, en una segunda hoja, plasma los resultados [manualmente], pero explica en la HOJA, de donde viene cada resultado y el porque, de esta forma se entenderá realmente que es lo que deseas hacer, porque lo que yo logro interpretar, es que quieres ir filtrando cada columna e ir sumando esos valores, pero no me queda claro donde se debe poner ese resultado

 

Saludos

Luis paz Principiante

Luis paz

publicado
publicado
En 14/12/2019 at 21:15 , segalo dijo:

Buen dia 

Recuerro a ustedes papar poder validar el correcto cierre del ciclo de esta macro.

El ciclo afectado es el FOR que tiene la variable n debe trabajar hasta el 23, pero cuando llega a 24, sigue con el ciclo de numero1 y de suma y continua trabajando con errores.

como puedo hacer para que la n al llegar a 24 finalice la macro y no realice las demas actividades  ? ya movi los Next pero no lo he logrado, espero me puedan dar una guia 

Gracias 

 

esta es la macro

 

Sub Union()
'
Dim fila, RR As Long

Dim n&, cCriterio$, H&, g&, y&

   fila = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row

    j = 5
   y = 1
    
  For H = 5 To 23
    
    Dim aCol, t&, LE$
    aCol = Array("E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y")
    For t = LBound(aCol) To UBound(aCol)
    LE = aCol(t)
    

For n = j To 23
        If n = j Then cCriterio = "<>0" Else cCriterio = "0"
        ActiveSheet.Range("$A$11:$AH$" & fila).AutoFilter Field:=n, Criteria1:=cCriterio
   
           ' numero1
    Range("A12").Select
    ActiveCell.FormulaR1C1 = y
    Range("B12").Select
    Selection.End(xlDown).Select
    Range("A" & fila).Select
    ActiveCell.FormulaR1C1 = y
    Range("A" & fila).Select
    Selection.Copy
    Range(Selection, Selection.End(xlUp)).Select
    Selection.Resize(Selection.Rows.Count + 1).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Selection.End(xlUp).Select
    ActiveWindow.SmallScroll Down:=-24
    
    RR = fila - 11
    
    'MsgBox RR
    
     'suma
        Range(LE & 10).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(LE & 11).Select
    Selection.End(xlDown).Select
    Range(LE & fila).Select
    Application.CutCopyMode = False
   ActiveCell.Formula = "=SUBTOTAL(9," & LE & "12:" & LE & Selection.Row - 1 & ")"
    Range(LE & fila).Select
    Selection.Copy
    Selection.End(xlUp).Select
    Range(LE & 9).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
         
           Next n


    j = j + 1
    n = j
    y = y + 1

    Rows("11:11").Select
    ActiveSheet.ShowAllData
    Range("A10").Select
        
            Next t
          Next H

End Sub

 

 

Gracias 

Ciclo.xlsm 22 kB · 2 descargas

Aquí tienes una opciónCiclo.xlsm

bigpetroman Colaborador

bigpetroman

publicado
publicado

Saludos @segalo, te dejo el archivo con tres opciones.

1.- La primera es la macro tuya, que le coloque un opción para que NO te de el error.

2.- La segunda, en esencia hace lo mismo, solo que optimizado, y otra cosa, en la columna A colocas el numero del filtro a la que pertenece esa fila cierto?, si es asi (y que fue lo que entendi de tu macro), aqui esta bien, pero tu macro la coloca mal, revisa

3.- y una opcion sin usar el filtro automático

 

suerte

Ciclo.xlsm

Jose BN Gran colaborador

Jose BN

publicado
publicado
En 16/12/2019 at 11:54 , Antoni dijo:

Este foro se ha quedado embuclado en el día de la marmota. ???

Vaya! No sé con precisión el día pero voy anotando en el calendario....

Archivado

Este tema está ahora archivado y está cerrado a más respuestas.

Ir al listado de temas

  • 109 ¿Te parecen útiles los tips de las funciones? (ver tema completo)

    1. 1. ¿Te parecen útiles los tips de las funciones?


      • Sí
      • No
      • Ni me he fijado en ellos

  • Ayúdanos a mejorar la comunidad

    • Mantenimiento de la comunidad
      Donaciones recibidas este mes: 0.00 EUR
      Objetivo: 130.00 EUR

  • Archivos

  • Estadísticas de descargas

    • Archivos
      188
    • Comentarios
      98
    • Revisiones
      29
    Más información sobre "Cambios en el Control Horario"
    Última descarga
    Cambios en el Control Horario
    Por pegones1

    4    1

  • Crear macros Excel

  • Mensajes

    • DiegoPC
      FORMULA PARA BUSCAR DIFERENTES RESULTADOS Y MOSTRARLOS

      Por DiegoPC · publicado

      Hola, veo que tienes 365, así que esta forma funcionará   Almacen.xlsx
    • jues
      Guardar Formulario en PDF

      Por jues · publicado

      Buenos días  @LeandroA espero estes bien Tengo un caso idéntico al planteado en la siguiente pregunta: Sin embargo, a diferencia de quien planteo originalmente la pregunta al correr el código no obtengo ningún resultado podrían ayudarme a resolver este inconveniente y que al hacer click en el Botón Guardar (CommandButton3) del Formulario RCS (frmrcs) el archivo pdf quede configurado con orientación vertical, márgenes superior, inferior, derecho e izquierdo = 1 y en página tamaño carta. Si acaso influye uso Microsoft Excel LTSC MSO (versión 2209 Compilación16.0.1.15629.20200) de 64 bits Mucho le sabre agradecer la ayuda que me pueda dar  RCS PRUEBA - copia.xlsm
    • DiegoLG
      Surtido de Mercancía

      Por DiegoLG · publicado

      @JSDJSDCon gusto mi estimado Para la opción 1: Sub Surtirhastadondealcanse() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 4 Dim filaFin As Integer: filaFin = 7 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Else solicitudes(i) = 0 End If surtido(i) = "POR FALTA STOCK" Next i ' Surtir de acuerdo al inventario disponible For i = 1 To numClientes If solicitudes(i) > 0 Then If inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) ElseIf inventario > 0 Then surtido(i) = inventario totalSurtido = totalSurtido + inventario inventario = 0 Else surtido(i) = "POR FALTA STOCK" End If End If Next i ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = "POR FALTA STOCK" Then .Value = surtido(i) .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Para la opción 2:   Sub surtirenpartesiguales() Dim ws As Worksheet Set ws = ThisWorkbook.Sheets(1) Dim filaInicio As Integer: filaInicio = 13 Dim filaFin As Integer: filaFin = 16 Dim colInventario As Integer: colInventario = 2 Dim colSolicitudesInicio As Integer: colSolicitudesInicio = 4 ' Columna C Dim colResultadoInicio As Integer: colResultadoInicio = 9 ' Columna I Dim colTotalSurtido As Integer: colTotalSurtido = 12 ' Columna L Dim colFinalInventario As Integer: colFinalInventario = 13 ' Columna M Dim numClientes As Integer: numClientes = 3 Dim fila As Integer, i As Integer For fila = filaInicio To filaFin Dim inventario As Double inventario = Val(ws.Cells(fila, colInventario).Value) Dim solicitudes(1 To 3) As Double Dim surtido(1 To 3) As Variant Dim totalSurtido As Double: totalSurtido = 0 Dim totalPedido As Double: totalPedido = 0 ' Leer solicitudes For i = 1 To numClientes If IsNumeric(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) Then solicitudes(i) = CDbl(ws.Cells(fila, colSolicitudesInicio + i - 1).Value) totalPedido = totalPedido + solicitudes(i) Else solicitudes(i) = 0 End If surtido(i) = 0 Next i ' Si hay suficiente inventario, surtir lo que el cliente pide If inventario >= totalPedido Then For i = 1 To numClientes If solicitudes(i) > 0 And inventario >= solicitudes(i) Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) End If Next i Else ' Reparto base igualitario Dim baseSurtido As Long baseSurtido = Int(inventario / numClientes) For i = 1 To numClientes If solicitudes(i) > 0 Then If solicitudes(i) <= baseSurtido Then surtido(i) = solicitudes(i) inventario = inventario - solicitudes(i) totalSurtido = totalSurtido + solicitudes(i) Else surtido(i) = baseSurtido inventario = inventario - baseSurtido totalSurtido = totalSurtido + baseSurtido End If End If Next i ' Repartir sobrante restante uno por uno, respetando lo pedido Do While inventario > 0 For i = 1 To numClientes If surtido(i) < solicitudes(i) Then surtido(i) = surtido(i) + 1 totalSurtido = totalSurtido + 1 inventario = inventario - 1 If inventario = 0 Then Exit For End If Next i Loop End If ' Escribir resultados en las columnas correspondientes para cada cliente For i = 1 To numClientes With ws.Cells(fila, colResultadoInicio + i - 1) If surtido(i) = 0 Then .Value = "POR FALTA STOCK" .Font.Color = vbRed Else .Value = surtido(i) .Font.Color = vbBlack End If End With Next i ' Escribir total surtido y existencia final ws.Cells(fila, colTotalSurtido).Value = totalSurtido ws.Cells(fila, colFinalInventario).Value = inventario Next fila MsgBox "Resultado surtido cargado con éxito...", vbInformation End Sub Saludos, Diego
    • jose_alk
      FORMULA PARA BUSCAR DIFERENTES RESULTADOS Y MOSTRARLOS

      Por jose_alk · publicado

      Buenos dias.  Estoy trabajando en una hoja para poder llevar un control de un pequeño almacén.  Tengo un pedido con varias líneas y "lotes" y necesito sacar las ubicaciones que coincidan con la referencia y lote que pone en el pedido. El problema viene cuando tengo la misma referencia y mismo lote en ubicaciones diferentes y necesito sacar la información en columnas diferentes. No se si  me he explicado bien, pero creo que con el ejemplo adjunto se entiende mejor. Agradecería mucho si me pudieran ayudar  Libro1.xlsx
    • jues
      Buscar Datos con un ComboBox

      Por jues · publicado

      Exelente solución mil gracias 

  • Visualizado recientemente

    • No hay usuarios registrado para ver esta página.
×
×
  • Crear nuevo...

Información importante

Echa un vistazo a nuestra política de cookies para ayudarte a tener una mejor experiencia de navegación. Puedes ajustar aquí la configuración. Pulsa el botón Aceptar, si estás de acuerdo.