Filtrar, contar únicos, sumar valores

He estado intentando realizar fórmulas o macros que me solucionen pero lo lo he conseguido, explico que es lo que hago y que es lo que quiero que haga excel.

**

Se tiene una lista de productos, la cual va en TIENDA (E1:E9835); MODELO (G1:G9835); y CANTIDAD (K1:K9835). Se pretende filtrar tienda01, contar cuantos modelos únicos hay para esa tienda, ir sumando las cantidades para no revazar el numero 60 que sera el corte de celdas. Cada modelo va por 12 piezas: 2 rojos, 4 azules, 4 amarillos, 2 verdes puede ir en 4 filas.

Al llegar la suma a 60 sin dejar fuera el conjunto del modelo escribe en la columna "O" fin20.(Corte)

Al llegar al final de la lista pase al la siguiente tienda del filtro TIENDA que pudiera ser TIENDA15 ya que no son consecutivas.

***

NOTA: considerar 6 modelos aproximados en 120 registros pues hay variaciones en modelo, ejemplo modelo RST500 rojo, RST500 negro, y el color va en otra celda, así que se puede repetir un modelo hasta 4 vees en tienda cambiando el color, en teoría se deben agrupar los modelos.

NOTA2: las cajas no pueden llevar más de 60 por lo que no podrá poner fin20 en una celda donde cote el consecutivo de modelos.

NOTA3: tampoco puede haber cortes con menos de 3 modelos, por lo que si la ultima serie van de 5 modelos y luego una de 1 modelo es incorrecto, debe generarse 2 cortes de 3 modelos y luego pasar a la siguiente tienda.

NOTA4: la idea es que en vez de cortes "fin20" copie el valor hoja2! A1 en todas las filas que van cumpliendo la regla, y al sumar 60 con 5 modelos(aprox) copiar valor de hoja2! A2 y así hasta terminar con las tiendas o se termine la lista de hoja2 (trabajando en hoja1)

YO: hasta ahorita tengo macros que hacen todo alrevez pero aun así requieren mano humana, mi macro me cuenta los valores hasta llegar a 60 y escribe fin20 que son aproximadame los renglones que avanza, si termina la fila y no acompleta 60 se para la macro, y entonces debo colocar a mano las que van de 3 modelos o de 4 modelos con 36 o 58 piezas, y se requiere filtrar las tiendas a mano desde filtros automáticos y correr la macro, filtrar y volver a correr la macro.

2 Respuestas

Respuesta
1

Logre escribir una macro que hace todo en forma semi automático, una que cuenta 8 lugares y realiza una fórmula sumando los lugares desplazados y así con 20, 16 y 12, todo esto lo tengo que hacer manual, si se pasa de 60 en la fórmula que suma, lo borro y coloco el de 16, si aun así se pasa, ¿lo borro y coloco el de 12 y continuo... habrá forma de que eso lo haga VB?

Adjunto TXT del modulo.
Attribute VB_Name = "Módulo1"
Sub ImportarCSV()
Attribute ImportarCSV.VB_Description = "Importa un archivo CSV y activa filtros para trabajar.\n\nNO ES NECESARIO EJECUTAR LA MACRO ""PREPARAR"""
Attribute ImportarCSV.VB_ProcData.VB_Invoke_Func = "i\n14"
    Sheets.Add After:=ActiveSheet
    ActiveSheet.Name = "importado"
    Sheets("importado").Cells.ClearContents
    strFile = Application.GetOpenFilename("CSV, *.csv")
        If strFile = Empty Then
           response = MsgBox("No selecciono ningún fichero o esta vacío.", _
           vbOKOnly, "Error")
        Exit Sub
        Else
        End If
    With Sheets("importado").QueryTables.Add(Connection:= _
        "TEXT;" & strFile _
        , Destination:=Sheets("carga").Range("$A$1"))
        .Name = "fichero"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True 'CSV: punto y coma
        .TextFileCommaDelimiter = True 'CSV: coma
        .TextFileSpaceDelimiter = False 'CSV: espacio
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1) '15 columnas
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    'prepara formato del importado listo para trabajr con filtros y celdas ocultas
    Range("A1:Q1").Select
    Selection.AutoFilter
    Range("F:F,H:H").Select
    Selection.NumberFormat = "0"
    Columns("C:D").Select
    Selection.NumberFormat = "dd/mm/yy;@"
    Range("B:D,F:F,H:H,L:L,M:M,N:N").Select
    Selection.EntireColumn.Hidden = True
    Range("A2").Select
    MsgBox "archivo cargado correctamente"
End Sub
Sub CONTROLES()
Attribute CONTROLES.VB_Description = "Activa los controles del archivo. Ctrl+a"
Attribute CONTROLES.VB_ProcData.VB_Invoke_Func = "a\n14"
'
' Macro2 Macro
' grabar test 1
'
' Acceso directo: CTRL+a
'
    Range("O3").Select
    Selection.End(xlUp).Select
    Rows("1:1").Select
    Range("O1").Activate
    Selection.Insert Shift:=xlDown
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "PEDIDO"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "TIENDA"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "MODELO"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "COLOR"
    Range("J1").Select
    ActiveCell.FormulaR1C1 = "TALL"
    Range("K1").Select
    ActiveCell.FormulaR1C1 = "PZ"
    Range("O1").Select
    ActiveCell.FormulaR1C1 = "CAJA"
    Range("P1").Select
    ActiveCell.FormulaR1C1 = "COUNT"
    Range("Q1").Select
    ActiveCell.FormulaR1C1 = "CHICA"
    Range("R1").Select
    ActiveCell.FormulaR1C1 = "FILAS"
    Range("S1").Select
    ActiveCell.FormulaR1C1 = "SUMA PZ"
    Range("T1").Select
    ActiveCell.FormulaR1C1 = "N° CAJAS"
    Range("U1").Select
    ActiveCell.FormulaR1C1 = "CAJA CHICA"
    Range("V1").Select
    ActiveCell.FormulaR1C1 = "CAJA GRANDE"
    'FORMULAS
   'Range("B2").formula = "=AND(ISNUMBER(ABS(RIGHT(RC[-1],8))),ISTEXT(LEFT(RC[-1],1)),LEN(RC[-1])=9)"
    Range("R2").FORMULA = "=SUBTOTAL(3,R3C11:R19297C11)"
    Range("T2").FORMULA = "=SUBTOTAL(3,R3C16:R19616C16)"
    Range("S2").FORMULA = "=SUBTOTAL(9,R3C11:R19296C11)"
    Range("U2").FORMULA = "=SUBTOTAL(3,R3C17:R19616C17)"
    Range("V2").FORMULA = "=R2C20-R2C21"
    Range("O3").Select
End Sub
Sub preparar()
Attribute preparar.VB_Description = "Esta macro activa filtros y oculta celdas para trabajar.\n\nUSAR SOLO SI ABRIO EL ARCHIVO CSV DIRECTAMENTE, SI IMPORTO EL ARCHIVO, ESTA TAREA YA SE REALIZO."
Attribute preparar.VB_ProcData.VB_Invoke_Func = "e\n14"
'no usar si importo un archivo csv.!!
MsgBox "no usar si importo archivo"
    Range("A1:Q1").Select
    Selection.AutoFilter
    Range("F:F,H:H").Select
    Selection.NumberFormat = "0"
    Columns("C:D").Select
    Selection.NumberFormat = "dd/mm/yy;@"
    Range("B:D,F:F,H:H,L:L,M:M,N:N").Select
    Selection.EntireColumn.Hidden = True
    Range("A2").Select
    MsgBox "Listo para trabajar."
End Sub
Sub paraCajas()
Attribute paraCajas.VB_Description = "Esta macro genera las pestañas y formatos necesarios para capturar lista de cajas."
Attribute paraCajas.VB_ProcData.VB_Invoke_Func = "r\n14"
' crear pestañas para cargar cajas Macro OK
'
    'cambia nombre de pestaña 1 a caja
    Sheets(1).Select
    Sheets(1).Name = "carga"
    'genera pestaña 2 y cambia nombre a cajagrande
    Sheets.Add After:=ActiveSheet
    Sheets(2).Select
    Sheets(2).Name = "cajagrande"
    ActiveCell.Offset(0, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "cajas grandes"
    ActiveCell.Offset(1, 0).Range("A1").Select
    'ingresa formula para validar cajas en cajagrande
    Range("B2").Select
    ActiveCell.Select
    Range("B2").FORMULA = "=AND(ISNUMBER(ABS(RIGHT(RC[-1],8))),ISTEXT(LEFT(RC[-1],1)),LEN(RC[-1])=9)"
    ActiveCell.Select
    Range("B2").Select
    Selection.AutoFill Destination:=Range("B2:B502"), Type:=xlFillDefault
    ' verdaderoverde Macro
    Columns("B:B").Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=VERDADERO"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16752384
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    'valida tamaño de celda
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "V12345670"
    Range("B2").Select
    Columns("B:B").EntireColumn.AutoFit
    Range("A2").Select
    ActiveCell.FormulaR1C1 = ""
    'activa en A2 listo para capturar cajas
    Range("A2").Select
    'genera pestaña 2 y cambia nombre a cajachica
    Sheets.Add After:=ActiveSheet
    Sheets(3).Select
    Sheets(3).Name = "cajachica"
    ActiveCell.Offset(0, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "cajas chicas"
    ActiveCell.Offset(1, 0).Range("A1").Select
    'ingresa formula para validar cajas
    Range("B2").Select
    ActiveCell.Select
    Range("B2").FORMULA = "=AND(ISNUMBER(ABS(RIGHT(RC[-1],8))),ISTEXT(LEFT(RC[-1],1)),LEN(RC[-1])=9)"
    ActiveCell.Select
    Range("B2").Select
    Selection.AutoFill Destination:=Range("B2:B502"), Type:=xlFillDefault
        ' verdaderoverde Macro
    Columns("B:B").Select
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
        Formula1:="=VERDADERO"
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    With Selection.FormatConditions(1).Font
        .Color = -16752384
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).StopIfTrue = False
    'valida tamaño de celda
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "V12345670"
    Range("B2").Select
    Columns("B:B").EntireColumn.AutoFit
    Range("A2").Select
    ActiveCell.FormulaR1C1 = ""
    'activa en A2 listo para capturar cajas
    Range("A2").Select
End Sub
Sub Modelos_2()
Attribute Modelos_2.VB_Description = "Cuenta 8 lugares abajo y suma 8 arriba.\n\n2 MODELOS"
Attribute Modelos_2.VB_ProcData.VB_Invoke_Func = "l\n14"
' Macro Ctrl + L
' cuenta 8 lugares abajo y suma 8 arriba
    ActiveCell.Offset(7, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "2 Modelos"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-7]C[-5]:RC[-5])"
    ActiveCell.Offset(0, -1).Range("A1").Select
End Sub
Sub Modelos_3()
Attribute Modelos_3.VB_Description = "Cuenta 12 lugares abajo y suma 12 arriba.\n\n3 MODELOS"
Attribute Modelos_3.VB_ProcData.VB_Invoke_Func = "n\n14"
' cuenta 12 lugares abajo y suma 12 arriba
' Acceso directo: CTRL+n
    ActiveCell.Offset(11, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "3 Modelos"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-11]C[-5]:RC[-5])"
    ActiveCell.Offset(1, 0).Range("A1").Select
End Sub
Sub Modelos_4()
Attribute Modelos_4.VB_Description = "Cuenta 16 lugares abajo y suma 16 arriba.\n\n4 MODELOS"
Attribute Modelos_4.VB_ProcData.VB_Invoke_Func = "m\n14"
' cuenta 16 lugares abajo y suma 16 arriba
' Acceso directo: CTRL+m
    ActiveCell.Offset(15, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "4 Modelos"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-15]C[-5]:RC[-5])"
    ActiveCell.Offset(1, 0).Range("A1").Select
End Sub
Sub Modelos_5()
Attribute Modelos_5.VB_Description = "Cuenta 20 lugares abajo y suma 20 arriba.\n\n5 MODELOS"
Attribute Modelos_5.VB_ProcData.VB_Invoke_Func = "q\n14"
'cuenta 20 lugares abajo y suma 20 arriba
' Acceso directo: CTRL+q
    ActiveCell.Offset(19, 0).Range("A1").Select
    ActiveCell.FormulaR1C1 = "5 Modelos"
    ActiveCell.Offset(0, 1).Range("A1").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-19]C[-5]:RC[-5])"
    ActiveCell.Offset(1, 0).Range("A1").Select
End Sub
'estas macros son para copiar las cajas de las pestañas "cajagrande" y "cajachica" a la pestaña "carga"
Sub cajagrande()
Attribute cajagrande.VB_Description = "Asigna el campo siguiente de la lista en pestaña ""cajagrande"""
Attribute cajagrande.VB_ProcData.VB_Invoke_Func = "y\n14"
' asignar caja grande Macro
' Acceso directo: CTRL+y
'
    Range(Selection, Selection.End(xlDown)).Select
    Sheets("cajagrande").Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.Copy
    Sheets("carga").Select
    ActiveSheet.Paste
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
End Sub
Sub cajachica()
Attribute cajachica.VB_Description = "Asigna el campo siguiente de la lista en pestaña ""cajachica"""
Attribute cajachica.VB_ProcData.VB_Invoke_Func = "u\n14"
' asignar caja chica Macro
' Acceso directo: CTRL+U
'
    Range(Selection, Selection.End(xlDown)).Select
    Sheets("cajachica").Select
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.Copy
    Sheets("carga").Select
    ActiveSheet.Paste
    ActiveCell.Offset(1, 0).Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("A1").Select
End Sub

Respuesta

Revisar las siguientes Recomendaciones en mi canal:

Cursos de Excel:

https://www.youtube.com/watch?v=w7MYL3wDgH4&t=3s

https://www.youtube.com/watch?v=dy9w9zbkCaw&t=644s

https://www.youtube.com/watch?v=7Xhs04vhrtg&t=188s

------------------------

Cursos de Macros:

https://www.youtube.com/watch?v=PupmVvM16-8&t=1s

https://www.youtube.com/watch?v=f_x8pstpNqc&t=3s

https://www.youtube.com/watch?v=5k0szqErdXg&t=689s

------------------------

Encuentra más sobre Excel y Macros en mi canal.

Comenta los vídeos para más propuestas de vídeos.

Sal u dos Dante Amor

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas

Macro copiar hoja y cambiarle nombre al MES siguiente del array?

Seria posible crear una macro que copie una hoja "MES (tipo)" y que la nueva hoja copiada se llamase "MES ENERO", y que al ejucutar nuevamente la macro copiase la hoja "MES (tipo)" y que la nueva hoja se llamase "MES FEBRERO", y asi sucesivamente...
1 respuesta

Excel VBA Macro Acregar Símbolo "/" para convertir Fecha

Podrán sugerirme Algún código que inserte "/", en celda activa, para que excel lo tome como fecha. Ejemplo: Celda B3 Texto "1022024" Solución: Celda B3 Modificada: 01/02/2024
2 respuestas

¿Cómo separo dos números que se encuentran en una sola celda de excel?

En una celda de excel se encuentran dos cantidades separadas por un guion. Quisiera separar el primer número en una segunda celda y el segundo número en una tercer celda. Ejemplo: A 1 48,264 - 65,371 2 55,555 - 66,666 3 . . . Debería quedar así: A B...
2 respuestas

Al seleccionar celda extraer sus dígitos automáticamente

Necesito dos favores, la idea es que al seleccionar una celda numérica de 4 dígitos del rango "af1;aj42" esta automáticamente extraiga sus cifras a la columna "a1, b1, c1, d1" como se muestra en la imagen Y lo segundo como puedo quitarle el msgbox a...
2 respuestas

Se puede agregar voz a Excel

Tengo una pantalla de vuelo de vuelo donde anotó despegues y arribos, Quiero que cada vez que se produzca un despegue y se agregue hora o aterrice alguno y se ponga la hora, excel diga o se escuche atención Aterrizaje o Atención despegue.
3 respuestas

Gráfico Comparativo por Semanas, en Power Bi.

Espero se encuentren muy bien. Tengo una tabla en Power BI con fechas, códigos, costos y cantidades. La necesidad que tengo es de crear un gráfico o tabla donde pueda comparar y analizar el comportamiento de los costos y las cantidades de un código...
1 respuesta

En una lista para pedidos tengo varios formularios

En una lista para pedidos con varios formularios la vengo usando desde hace tiempo sin ningún problema pero hace días la abrí para hacer un pedido y al pisar en el cuadro donde apunta la flecha para que me abra un otro cuadro donde coloco ciertos...
2 respuestas

Código VBA para crear un botón y guardar en PDF

Tengo un archivo word con 7 capturas, una en cada página (1-7), cual seria el código para crear un botón en la barra de herramientas de acceso rápido para convertir en PDF cada página. El resultado seria 7 pdf.
2 respuestas

Como evitar que se duplique un dato en la base de datos

Trato que al ingresar los datos a la base de datos si en la columna "B" DNI es una cifra que ya esta en dicha base me lo indique en un Msgbox "El Dato ya existe" Esta es la macro que tengo en el botón Aceptar Private Sub Aceptar_Click()...
2 respuestas

Detectar si he marcado Celda dentro de un Rango de Excel.

Tengo un Rango en Hoja Excel: RgoDatos >> $B$3:$V$39 Quiero detectar si la celda que selecciono está dentro de ese Rango Si no está que por omisión me marque B3.
1 respuesta