Antoni

La macro contiene solo instrucciones básicas de VBA, funcionaría en cualquier versión de Excel. Y una cosita, en el momento que modificas mi macro, esta, pasa a ser tu macro y pierdes la garantía por mi parte.

He descargado tu archivo y funciona correctamente, revisa el video adjunto:

No has especificado cuales son las celdas a validar si están vacías, te he puesto un ejemplo para el rango A1:A6, corrige a voluntad: Sub Borrar() '------- Corregir las celdas según necesidad If Range("A1") = "" Or _ Range("A2") = "" Or _ Range("A3") = "" Or _ Range("A4") = "" Or _ Range("A5") = "" Or _ Range("A6") = "" Then MsgBox "Hay celdas vacías", vbInformation Exit Sub End If '------- Range("C5").ClearContents Range("C7").ClearContents Range("C8").ClearContents Range("C23").ClearContents Range("C24").ClearContents Range("C39").ClearContents Range("C40").ClearContents Range("C55").ClearContents Range("C56").ClearContents Range("C71").ClearContents Range("C72").ClearContents Range("C87").ClearContents Range("C88").ClearContents Range("C103").ClearContents Range("C104").ClearContents Range("C119").ClearContents Range("C120").ClearContents Range("C135").ClearContents Range("C136").ClearContents Range("C151").ClearContents Range("C152").ClearContents End Sub

Ha sido más sencillo de lo que parecía, o eso creo. Pruebas.xlsb

Déjame un par de días, a ver si te apaño algo.

Para actualizar una celda con un valor numérico con un texto (TextBox), debes convertir el texto a número con una función de conversión de tipos (CInt(), CLng(), CDbl(), CCur(),.......) Poe ejemplo : Range("A1")=CDbl(TextBox1) pero debes asegurarte que contiene solamente números 0-9 y adicionalmente, el separador decimal (punto o coma según el país), para ello tienes la función IsNumeric(), por ejemplo: IF IsNumeric(TextBox1) Then Range("A1")=CDbl(TextBox1) else MsgBox "El TextBox1 no es numérico", VbCritical End If

No tengo ni idea de tablas dinámicas, pero la grabadora de macros muestra: ActiveSheet.PivotTables("TablaDinámica1").PivotFields("Campo 3").AutoSort xlAscending, "Campo 3"

Prueba este código. Sin el archivo no te puedo ajustar más. Private Sub btnCargaBancos_Click() 'El tipo de dato debe especificase para cada variable Dim TasaCompra As Double, TasaVenta As Double, InvBanesco As Double, InvVzla As Double Dim MontoBanesco As Double, MontoVzla As Double, TasaDiaBan As Double, TasaDiaVzla As Double Dim TasaActual As Double 'Hay que comprobar que los textbox tienen contenido numérico 'Los datos numéricos solo pueden contener números y el separador decimal, cualquier otro caracter dará error al convertir If Not IsNumeric(txtInverBanesco) Or _ Not IsNumeric(txtInverVzla) Or _ Not IsNumeric(txtTasaCompra) Or _ Not IsNumeric(txtTasaVenta) Then MsgBox "Los datos deben ser numéricos", vbCritical Exit Sub End If InvBanesco = CDbl(txtInverBanesco) InvVzla = CDbl(txtInverVzla) TasaCompra = CDbl(txtTasaCompra) TasaVenta = CDbl(txtTasaVenta) 'Los datos de los divisores no pueden ser 0 (Indeterminación matemática) If TasaCompra = 0 Or _ InvBanesco = 0 Or _ InvVzla = 0 Then MsgBox "Los datos no admiten valor cero", vbCritical Exit Sub End If MontoBanesco = (InvBanesco / TasaCompra) * (1 - 0.18 / 100) * (TasaVenta * (1 - 0.18 / 100)) MontoVzla = (InvVzla / TasaCompra) * (1 - 0.18 / 100) * (TasaVenta * (1 - 0.18 / 100)) TasaDiaBan = (MontoBanesco / InvBanesco) * (1 - 0.055) TasaDiaVzla = (MontoVzla / InvVzla) * (1 - 0.055) If TasaDiaBan < TasaDiaVzla Then TasaActual = TasaDiaBan Else TasaActual = TasaDiaVzla End If 'En VBA, los datos numéricos no admiten ser formateados, formatear directamente en las celdas, 'MontoBanesco = FormatNumber(MontoBanesco, 2, True, vbFalse) 'MontoVzla = FormatNumber(MontoVzla, 2, True, vbFalse) 'TasaActual = FormatNumber(TasaActual, 5, True, False) txtBcoBanesco = MontoBanesco txtBcoVenezuela = MontoVzla txtTasaDiaria = TasaActual End Sub

Si no me he liado con los paréntesis: Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False Application.Calculation = xlManual Application.EnableEvents = False If Not Intersect(Target, Range("$L$5:$Y$9")) Is Nothing Then Range("E22") = WorksheetFunction.Sum(Range("E4:E21")) Range("E23") = WorksheetFunction.Sum(Range("E4:E19")) Range("E24") = Range("E23") - WorksheetFunction.Sum(Range("I4:I7")) Range("I22") = WorksheetFunction.Sum(Range("I4:I21")) Range("I4") = Range("E23") * 0.1 Range("I5") = Range("EN10") * Range("EN11") Range("I6") = Range("E23") * 0.0127 Range("I7") = Range("E23") * 0.006 Range("I25") = Range("E22") - Range("I22") Range("I12") = Range("E24") * 0.03 Range("C7") = Range("EQ8") - Range("EQ9") + Range("EN13") + Range("EN14") + Range("EN15") + Range("EN16") Range("C9") = Range("EQ9") + Range("EN17") + Range("EN18") + Range("EN19") Range("E7") = Range("E4") / Range("C4") * 7 / 44 * 1.5 * Range("C7") Range("E8") = Range("E4") / Range("C4") * 7 / 44 * 0.3 * Range("C8") Range("E9") = Range("E4") / Range("C4") * 7 / 44 * 1.3 * 1.5 * Range("C9") End If Application.Calculation = xlAutomatic Application.ScreenUpdating = True Application.EnableEvents = True End Sub

Abre el adjunto y pulsa el botón GENERAR HOJAS y luego pulsa sobre cualquier fecha del calendario para ir a la hoja deseada. Observa que he añadido 2 botones en la hoja CALENDARIO, uno para generar las hojas y otro para eliminarlas. También he añadido una flechita azul en las hojas generadas para volver a la hoja CALENDARIO. Estas son las macros: En la hoja CALENDARIO: Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim d As Integer, m As Integer, a As Integer On Error Resume Next If IsNumeric(Target) Then If Not Target = "" Then x = Int((Target.Row - 6) / 9) y = Int((Target.Column - 5) / 8) + 1 m = x * 6 + y d = Target a = Right([E3], 4) Sheets(Format(d, "00") & "-" & Format(m, "00") & "-" & a).Activate End If End If End Sub En el Módulo1: Sub GenerarHojas() Application.ScreenUpdating = False Application.CopyObjectsWithCells = True Dim a As Integer a = Right([E3], 4) With Sheets("ORIGI") For fecha = CDate("01/01/" & a) To CDate("31/12/" & a) '<-- Periodo a generar .Copy After:=Sheets(Sheets.Count) ActiveSheet.Name = Format(fecha, "dd-mm-yyyy") [B4] = [B4] & " " & fecha Next End With Volver End Sub '-- Sub EliminarHojas(): On Error Resume Next Application.ScreenUpdating = False Application.DisplayAlerts = False Dim a As Integer a = Right([E3], 4) For fecha = CDate("01/01/" & a) To CDate("31/12/" & a) '<-- Periodo a eliminar Sheets(Format(fecha, "dd-mm-yyyy")).Delete Next End Sub '-- Sub Volver() Sheets("CALENDARIO").Activate End Sub Libro1 (15).xlsm

Sub GenerarHojas() Application.ScreenUpdating = False With Sheets("Hoja1") '<--- Hoja a copiar For fecha = CDate("01/01/2024") To CDate("31/12/2024") '<--- Periodo a generar .Copy After:=Sheets(Sheets.Count) ActiveSheet.Name = Format(fecha, "dd-mm-yyyy") Next .Activate End With End Sub Y por si las quieres eliminar: Sub EliminarHojas(): On Error Resume Next Application.ScreenUpdating = False Application.DisplayAlerts = False For fecha = CDate("01/01/2024") To CDate("31/12/2024") '<-- Periodo a eliminar Sheets(Format(fecha, "dd-mm-yyyy")).Delete Next End Sub

Sub FormulaDocs() Set ws = ThisWorkbook.Sheets("Conte") Set Rng = ws.Range("U17:U" & ws.Cells(ws.Rows.Count, "U").End(xlUp).Row) For Each CELL In Rng If CELL.Value <> "" Then F = CELL.Row CELL.Offset(0, -5).FormulaLocal = "=SI.ERROR(SI(ESNUMERO(HALLAR($U" & F & ";$G" & F & "));BUSCARV($V$2&V$3&$U" & F & ";INDIRECTO(""'""&Z$2&""'!""&""G3:J10"");3;FALSO););"""")" End If Next CELL End Sub

¡Perfecto!, con esto me ahorro la solución. 😀

A ver si mañana encuentro un hueco y te apaño algo.

Preguntas: ¿Las hojas ya existen o hay que crearlas? Si ya existen, ¿Hay que sustituir la información o hay que añadirla a la existente? Quedo a la espera.

No va a ser necesario distinguir el tipo de proceso entre 1 y 2. Revisa el adjunto a ver si es eso lo que quieres. Function MediaAttention(mImp As Range, _ q25 As Range, q50 As Range, _ Optional q75 As Range, _ Optional q100 As Range) As Double '-- Opción 1 If q75 Is Nothing And q100 Is Nothing Then MediaAttention = q25 / q50 Exit Function End If '-- Opción 2 MediaAttention = ((0.25 * (q25 - q50)) / mImp) + _ ((0.5 * (q50 - q75)) / mImp) + _ ((0.75 * (q75 - q100)) / mImp) + _ (q100 / mImp) End Function Media Attention Formula 1.2.xlsb

He analizado la UDF y entiendo perfectamente lo que hace, lo que no entiendo es lo que pretendes hacer. Mejor sube un ejemplo resuelto de como debería funcionar la UDF con los nuevos parámetros solicitados.

Supongo que lo que quiere el consultante es obtener el mes de una fecha de la columna E de la hoja Primaria, y al no estar calificado el rango, hace referencia a la hoja activa, que seguramente, será una hoja de menú, pero ya se sabe, suponer es la mejor manera de equivocarse. Saludos. 🙂

La celda a la que haces referencia está vacia, podría ser consecuencia de la falta de calificación del rango, a Range("E" & X).Text le falta el punto de calificación, debe ser así .Range("E" & X).Text. A Abraham: El (0) hace referencia al primer elemento del array que devuelve la instrucción Split(). 😉

Formato personalizado(*): m Ctrl+j :s y luego Ajustar texto. Te dejo un ejemplo. (*) De una respuesta de Héctor Miguel Solo minutos.xlsx

C:\Users\tu usuario\AppData\Roaming\Microsoft\Excel\XLSTART

Te he modificado un poco los procedimientos de alta/modificación. Base de datos de alumnos2 (1).xlsm

Revisa el adjunto. Ingreso Por user Form.xlsm

Más o menos sería esto. Libro1 (13).xlsm