Macro para buscar la mayor y menor cantidad de un rango de celdas en varias hojas.
Me gustaría saber si me puedes ayudar con un proyecto personal, se basa en una macro que funcione en dos celdas, una me va a dar la menor cantidad y otra la mayor. Dicho resultado va depender de otras dos celdas, dependiendo de la informacion que yo coloque en dichas celdas, me va a buscar las cantidades en una hoja especifica y un rango especifico, tiene varias condiciones, ¿Crees que puedas ayudarme
1 Respuesta
H0la Chrisr:
Estuve revisando tu requerimiento. Cuando no tienes una categoría específica, no hay problemas, pero cuando seleccionas una categoría, se complica el asunto. Igual puedo implementar algo que no será lo más eficiente, pero para la cantidad de registros que vas a tener (200 x 12) quizá no demore tanto.
Otra forma que puede ser más óptima, es no agregarlo como una función en la celda, sino, implementar un botón, que al presionarlo te calcule el máximo y el mínimo. Déjame darle una vuelta más y te respondo.
S@lu2
Mi archivo se basa en 13 hojas, 12 de ellas son los meses del año, les puse como nombre a cada una las 3 primeras letras de cada mes (Ene, Feb, Mar...). En cada hoja se llevará un registro de gastos por categoría, entonces, en la hoja número 13 tengo 4 celdas, una de ellas es para seleccionar la categoría que deseo consultar el menor/mayor gasto que hice (D13), esta tiene una lista desplegable con todas las categorías de gastos que uso. En la segunda celda (F13), hay una lista desplegable con el nombre de cada hoja (NOMBRE DEL MES). Entonces, más abajo tengo dos celdas, (D32), es donde me buscará la menor cantidad que gasté, dependiendo de la categoría y el mes que seleccione. En (H32) me hará los mismo, solo que buscará la mayor cantidad que gasté. OJO: En la primera celda (D13), cree una opción llamada "En general" que es para tomar en cuenta todas las categorías y en la segunda celda (F13) cree una opción llamada "Todos", que es para buscar la menor/mayor cantidad de gastos a nivel anual, es decir, todos los meses. Si selecciono "En general" en la primera celda y en la segunda pongo un mes, me buscará el menor/mayor gasto que hice ese mes en general, es decir entre todas las categorías juntas buscar el menor y mayor gasto. Si selecciono "En general" en la primera celda y "Todos" en la segunda celda, me buscará el menor/mayor gasto que hice en el añoen general, y si selecciono una categoría en la primera celda y en la segunda pongo "Todos", me buscará el menor/mayor gasto que hice en el año con relación a dicha categoría.
Ahí te dejé la descripción de lo que necesito, esa descripción te la mandé hace mucho, es con el fin de ayudar, analiza todo y me avisas, o si necesitas una foto, gracias.
H0la Chrisr:
El uso de esta función es análogo a la función anterior.
RngCeldaCat: Celda en que está el criterio de categoría
StrColCat: Columna desde la que tomará el dato en la hoja de origen.
RngCeldaMes: La celda que contiene el mes que se desea buscar
StrOp: MAX si deseas encontrar el máximo y MIN si deseas encontrar el mínimo.
Suponiendo que quieres encontrar el máximo de la categoría indicada en D13, los datos son obtenidos desde la columna A de cada hoja y el mes que deseas buscar está en F13, entonces en la celda dónde deseas obtener este valor insertas esto:
=fcnMinMax(D13;"A";F13;"MAX")
(Creo que tus separadores eran comas, si es así, reemplaza los punto y como (;) por comas (,))
Dejo la macro a continuación:
Function fcnMinMax(rngCeldaCat As Range, strColCat As String, rngCeldaMes As Range, _ Optional strOp As String = "MAX") As Double 'Por GP' Dim strMeses() As Variant Dim strCeldaCat As String, strCeldaMes As String, strCeldaResult As String Dim i As Integer, nFilas As Integer Dim rAux As Range, lngVal As Long, strNomRangoC As String, strNomRangoR As String, blnIni As Boolean, rCelda As Range Set rAux = Cells(Rows.Count, Columns.Count) strMeses = Array("Todos", "ene", "feb", "mar", _ "abr", "may", "jun", "jul", _ "ago", "sep", "oct", "nov", "dic") If LCase(rngCeldaMes) = "todos" Then 'Todos los meses' If LCase(rngCeldaCat) = "en general" Then 'Todas las categorías' For i = 1 To 12 nFilas = Sheets(strMeses(i)).Range("E200").End(xlUp).Row If strOp = "MAX" Then lngVal = WorksheetFunction.Max(Sheets(strMeses(i)).Range("E6:E" & nFilas)) fcnMinMax = IIf(fcnMinMax > lngVal, fcnMinMax, lngVal) Else lngVal = WorksheetFunction.Min(Sheets(strMeses(i)).Range("E6:E" & nFilas)) If blnIni Then fcnMinMax = IIf(fcnMinMax < lngVal, fcnMinMax, lngVal) Else fcnMinMax = lngVal blnIni = True End If End If Next Else For i = 1 To 12 'Una categoría específica' nFilas = Sheets(strMeses(i)).Range("E200").End(xlUp).Row strNomRangoC = Sheets(strMeses(i)).Name & "!" & strColCat & "6:" & strColCat & nFilas strNomRangoR = Sheets(strMeses(i)).Name & "!E" For Each rCelda In Range(strNomRangoC) If rCelda.Value = rngCeldaCat.Value Then If strOp = "MAX" Then fcnMinMax = IIf(fcnMinMax > Range(strNomRangoR & rCelda.Row).Value, _ fcnMinMax, Range(strNomRangoR & rCelda.Row).Value) Else If blnIni Then fcnMinMax = IIf(fcnMinMax < Range(strNomRangoR & rCelda.Row).Value, _ fcnMinMax, Range(strNomRangoR & rCelda.Row).Value) Else fcnMinMax = Range(strNomRangoR & rCelda.Row).Value blnIni = True End If End If End If Next Next End If Else 'Un mes específico' With Sheets(LCase(rngCeldaMes)) nFilas = .Range("E200").End(xlUp).Row If LCase(rngCeldaCat) = "en general" Then 'Todas las categorías' If strOp = "MAX" Then fcnMinMax = WorksheetFunction.Max(.Range("E6:E" & nFilas)) Else fcnMinMax = WorksheetFunction.Min(.Range("E6:E" & nFilas)) End If Else 'Una categoría específica' strNomRangoC = .Name & "!" & strColCat & "6:" & strColCat & nFilas strNomRangoR = .Name & "!E" For Each rCelda In Range(strNomRangoC) If rCelda.Value = rngCeldaCat.Value Then If strOp = "MAX" Then fcnMinMax = IIf(fcnMinMax > Range(strNomRangoR & rCelda.Row).Value, _ fcnMinMax, Range(strNomRangoR & rCelda.Row).Value) Else If blnIni Then fcnMinMax = IIf(fcnMinMax < Range(strNomRangoR & rCelda.Row).Value, _ fcnMinMax, Range(strNomRangoR & rCelda.Row).Value) Else fcnMinMax = Range(strNomRangoR & rCelda.Row).Value blnIni = True End If End If End If Next End If End With End If End Function
S@lu2
- Compartir respuesta