Máximos colaboradores
Popular Content
Showing content with the highest reputation since 04/03/24 in Mensajes
-
3 points
-
Te dejo una función, puedes usarla en macros y formularios o como fórmula. Function Edad(Identidad As String) As Variant Dim Año, Mes, Día '-- If Not IsNumeric(Identidad) Or Not Len(Identidad) = 11 Then Edad = "#Error Identidad" Exit Function End If '-- Año = CInt(Left(Identidad, 2)) If Año > Year(Date) - 2000 Then Año = Año + 1900 Else Año = Año + 2000 End If '-- Mes = CInt(Mid(Identidad, 3, 2)) Día = CInt(Mid(Identidad, 5, 2)) Edad = Year(Date) - Año '-- If Mes > Month(Date) Or _ (Mes = Month(Date) And Día > Day(Date)) Then Edad = Edad - 1 Exit Function End If End Function Cumpleaños Foro.xlsm3 points
-
Hola, una forma es: Private Sub UserForm_Initialize() Me.StartUpPosition = 0 'Establecer posición de forma manual Me.Top = 100 'Desde la parte superior Me.Left = 100 'Desde el margen izquierdo End Sub Lee sobre las propiedades Top y Left del Userform para mejor referencia. Saludos.3 points
-
Abre el adjunto y pulsa sobre el botón. Vale para cualquier cantidad de filas y columnas de Sheet1. copiar color.xlsm2 points
-
Hola, tal cual se plantea, solamente con macros (VBA); en todo caso, hacerlo a mano o con "CTRL + ;". Saludos.2 points
-
Bueno con el ejemplo así como lo tienes, te puedo compartir que ese error de referencia circular es el que te ayuda a mantener la fecha y la hora "congeladas" podrías evitarlo usando una columna auxiliar para el vacío pero la fórmula AHORA() te cambiara el resultado cada que la hoja se calcule o cuando le des guardar. Sin VBA de por medio será esperar el aporte de algún maestro o usuario avanzado. Si cambias de opinión pasa el tema para la otra sección. Saludos2 points
-
Para esa versión se me ocurre usar otra web y una UDF: Function InsertQRCode(celda As Range) As String Dim mirango As Range Dim QRCodeURL As String Set mirango = Application.Caller QRCodeURL = "https://quickchart.io/qr?text=" & celda.Value With ActiveSheet.Pictures.Insert(QRCodeURL) .Left = mirango.Left .Top = mirango.Top .Width = mirango.Width .Height = mirango.Height End With InsertQRCode = "" End Function2 points
-
Hola a todos, Otra opción podría ser: =BUSCARV(B30;DESREF(A$4;;COINCIDIR(C30;B$2:W$2;)-2;15;3);3;) ...fórmula que, insertada en D30, puede copiarse verticalmente hasta donde sea necesario (archivo adjunto). Nota: He modificado las fórmulas de C26:C27, convirtiéndolas en dinámicas; sólo habrá que revisar si el rango de suma es el que se desea. Sumas con condición (C).xlsx2 points
-
2 points
-
2 points
-
2 points
-
2 points
-
No todos los controles tienen las mismas propiedades: Private Sub Guardar(sh As Worksheet, r As String, ctrl As Control) If ctrl.Visible Then Select Case TypeName(ctrl) Case "Label" sh.Range(r).Value = ctrl.Caption Case "TextBox" sh.Range(r).Value = ctrl.Value End Select End If End Sub2 points
-
2 points
-
Prueba y comenta Private Sub Worksheet_Change(ByVal Target As Range) ' Salir si se seleccionan varias celdas a la vez If Target.Count > 1 Then Exit Sub ' Salir si el cambio está en la fila 1 If Target.Row = 1 Then Exit Sub ' Salir si el cambio está en una columna mayor a la columna 8 If Target.Column > 8 Then Exit Sub ' Intentar redimensionar la tabla dentro de la protección de hoja On Error GoTo ErrorHandler Me.Unprotect Password:="123" ' Redimensiona la tabla a la región actual del Target Me.ListObjects("Tabla1").Resize Target.CurrentRegion ' Proteger de nuevo con configuraciones específicas para permitir edición en la tabla Me.Protect Password:="123", _ AllowSorting:=True, _ AllowFiltering:=True, _ AllowUsingPivotTables:=True, _ AllowInsertingRows:=True, _ AllowDeletingRows:=True ' Restaurar control de errores On Error GoTo 0 Exit Sub ErrorHandler: MsgBox "Ocurrió un error al redimensionar la tabla. Verifica el nombre de la tabla y que los rangos estén correctos.", vbExclamation End Sub2 points
-
2 points
-
2 points
-
Hola, creo que Fernando tuvo un problema con su usuario del foro e igual nunca es recomendado titular un post hacia una persona o pedirle solo ayuda a una; recomiendo o que adjuntes tu archivo que tenga los datos tal cual los trabajas y, a mano, los coloques tal cual los necesitas y de ese modo será más fácil entenderte.2 points
-
Hola. La verdad es que, viendo tu lista y tu escueta explicación, pues realmente es casi imposible darte un consejo.2 points
-
2 points
-
Hola jues No soy Israel Cassales , pero intentaré darte otra visión del asunto. Estamos hablando de octubre de 2024. Que tiene entre sábados y domingos 8 días. En tu archivo te salen 9. Cuentas como festivo el día 12 de octubre, que es sábado, y por lo tanto no se cuenta, a ti te sale 1. Los días trabajados (laborados) dices que son 21, cuando son 23, contando el día "festivo" que no es, y el sábado o domingo que te sobra. Con ésta fórmula me salen los 23 días: =DIAS.LAB.INTL($D$6;FIN.MES($D$6;0);"0000011";'USUARIOS & PRIVILEGIOS'!$N$5:$N$34) La multiplicación por las 8 horas y por el NTT (que no se lo que es) te lo dejo a tí. Saludos.2 points
-
Que tal a todos, me permito aportar otra posible solución sin alterar la estructura del reporte: =CONTAR(UNICOS(--DIVIDIRTEXTO(A2; ; APILARH(CARACTER(10); "AB-")))) Espero les sea útil. ContarCodigosUnicos (Solucion).xlsx2 points
-
Prueba esta macro, vale para cualquier cantidad de filas/columnas. Const Naranja As Long = 6403322 Const Morado As Long = 11423218 Const Verde As Long = 4896057 Const Rojo As Long = 6709491 '-- Sub Resaltes() Dim Sales As Range, Fcst As Range Application.ScreenUpdating = False '-- For x = 2 To Range("A" & Rows.Count).End(xlUp).Row Step 2 For y = 4 To Cells(1, Columns.Count).End(xlToLeft).Column '-- Set Fcst = Cells(x, y) Set Sales = Cells(x, y).Offset(1) '-- Sales.Interior.ColorIndex = xlNone Fcst.Interior.ColorIndex = xlNone '-- If Sales <> "" Then If Round(Sales) = 0 And Round(Fcst) > 0 Then Sales.Interior.Color = Rojo Fcst.Interior.Color = Rojo End If '-- If Round(Sales) <> 0 And Round(Sales) < Round(Fcst) Then Sales.Interior.Color = Naranja Fcst.Interior.Color = Naranja End If '-- If Round(Sales) = Round(Fcst) Then Sales.Interior.Color = Verde Fcst.Interior.Color = Verde End If '-- If Round(Sales) <> 0 And Round(Fcst) < Round(Sales) Then Sales.Interior.Color = Morado Fcst.Interior.Color = Morado End If '-- End If Next Next End Sub2 points
-
Por la descripción se me ocurren un par de cosas que recomendarte, una podría ser la configuración de la región, así que en donde no se "abre" bien revisa que el separador de listas sea una coma. La otra no mencionas como lo mandas llamar pero se puede deducir que haces doble clic, así que igualmente en la que no abre bien prueba importar "manualmente" el .csv2 points
-
Sub BorrarCobros() With Sheets("Hoja1") Set rango = .Range("A1").CurrentRegion rango.AutoFilter Field:=12, Criteria1:="COBRADA" .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row) _ .SpecialCells(xlCellTypeVisible).EntireRow.Delete .AutoFilterMode = False End With End Sub Esta sería la otra variante2 points
-
Buenas, por lo que veo sería: en la función: Function GetDepthFromCSV(csvData As Variant, holeID As String) As Variant cambia la línea done crea el array lineData , el delimitador de esta mal: lineData = Split(csvData(i), ";") ' cambia "," por ";" y la captura del campo, cambia el número de columnas GetDepthFromCSV = lineData(3) ' Asume que la columna 1 es PROF_REC ' cambio por 3 de esta manera parece que funciona como lo quieres. saludos survey_test2_v1.xlsm2 points
-
Saludos totales, Considerando la respuesta del maestro ante la posibilidad de separar el resultado en dos celdas y considerando también que el consultante no desea usar macros. En esa circunstancia si nos ponemos creativos podemos sacar de la celda el resultado de la fórmula a una imagen. Su formula renombrada: =SI(B3=B7,"Resultado1",SI(B3=B8,"Resultado2",SI(B3=B9,"Resultado3"))) Así cuando cambie el resultado, cambiará la imagen que es una copia del resultado que tenemos en el rango inferior. Probablemente con un rango mayor de datos sea laborioso el crearlo pero es solo una idea que se me cruzo al leer la propuesta del Maestro @Victor7 a quien saludo cordialmente con el gusto de coincidir en este tema.2 points
-
Hola a todos, Otra posibilidad, con fórmula única M365, podría ser (no necesita cálculos ni rangos auxiliares): =LET(z;LAMBDA(a;CONTARA(UNICOS(FILTRAR(A2:A14;a>0))));y;C2:C14;APILARH(CONTARA(FILTRAR(y;y>0));EXCLUIR(BYCOL(C2:P14;z)-BYCOL(B2:O14;z);;1))) Al tratarse de una fórmula de matriz derramada, hay que asegurarse de borrar el rango D16:xxx16. De otra forma, aparecerá error #¡DESBORDAMIENTO! Saludos,2 points
-
Saludos totales Es una gran idea @simplifikndo y lamento parecer entrometido en su aporte, me gustan las recomendaciones que hace y por eso con pena de mi parte y sin intención de modificar el total de su idea con el rango auxiliar, vi que en la parte del conteo usa esta fórmula: =SI(CONTAR.SI(U$1:U$7,">"&0)>CONTAR.SI(T$1:T$7,">"&0),CONTAR.SI(U$1:U$7,">"&0)-CONTAR.SI(T$1:T$7,">"&0),0) Usando su mismo rango tal vez le podría interesar algo así: =SUMAPRODUCTO((U1:U7>0)*(T1:T7=0)) Una disculpa por la intromisión estimado @Matías86 Duda Lanzamiento - slp.xlsx2 points
-
Otra forma a partir de las tablas, los nombres de las hojas, el combo bancos y el nombre de las tablas deben ser iguales. Para Foro.xlsm2 points
-
¡Saludos a todos! @fx.ingenieria revisa el adjunto, donde con una sola fórmula matricial devolvemos los resultados buscados. He agregado un formato condicional para que se sombree la fila dependiendo de si el valor corresponde a un valor sin comas (es un título de grupo). ¡Bendiciones! Suma rangos variables .xlsx2 points
-
Saludos totales @simplifikndo Gran aporte y gusto de coincidir con usted de nuevo en un tema. @fx.ingenieria Hay una parte que me parece (al menos a mí) que no está clara en su consulta y es la siguiente: En los libros que amablemente manda y en sus explicaciones, no ha terminado de exponer cómo es que los rangos pasan de ser fijos a ser variables, así que mi participación se basa solo en deducciones y erróneamente no debería ser así porque está limitada al conocimiento que solo ésta en usted. Además que ya está siendo asistido por el compañero quien hace colaboraciones sobresalientes. Desde mis conjeturas una de las forma en que los rangos sean variables es porque se insertan filas o columnas, esto le debe causar problemas si quien lo hace no inserta dentro del rango, porque de ser así una suma natural de Excel debería servir porque el rango cambia automáticamente. Empero, si esta fila o columna se inserta al final del rango, entonces no se actualiza y las sumas son incorrectas. Una idea sencilla que sirve para evitar esto es combinar SUMA con DESREF ENFATIZO: Es importante señalar cómo pasan de fijos a variables sus rangos considerando que está buscando sumar valores justo dentro de ese rango y las fórmulas no se escriben automáticamente, a menos que se programe un evento que lo ocasione.2 points
-
Private Sub ComBanco_Change() Dim hojabuscada As String Dim ultFila As Long Dim ultCol As Long hojabuscada = ComBanco With Sheets(hojabuscada) ultFila = .Cells(.Rows.Count, 1).End(xlUp).Row ultCol = .Cells(6, .Columns.Count).End(xlToLeft).Column LstDiario.RowSource = .Range(.Cells(6, 1), .Cells(ultFila, ultCol)).Address(External:=True) End With End Sub El saldo inicial no se si quieres que se muestre, en caso contrario modifica la macro, simplemente cambia en la dos ultimas líneas del bloque with el 6 por el 7 Para Foro.xlsm2 points
-
2 points
-
2 points
-
Otra solución más. PRUEBA - copia.xlsm2 points
-
2 points
-
2 points
-
Sub ExportarCSV() Set hojaDatos = ThisWorkbook.Sheets("Datos") Set hojaCSV = ThisWorkbook.Sheets("CSV") ultimaFila = hojaDatos.Cells(hojaDatos.Rows.Count, "B").End(xlUp).Row Dim rangoCodigos As Range Set rangoCodigos = hojaDatos.Range("G1:IB1") rutaArchivoCSV = ThisWorkbook.Path & "\" nombreArchivoCSV = "archivo.csv" archivoCSV = FreeFile Open rutaArchivoCSV & nombreArchivoCSV For Output As archivoCSV For i = 2 To ultimaFila clave = hojaDatos.Cells(i, 2).Value mes = hojaDatos.Cells(i, 5).Value año = hojaDatos.Cells(i, 6).Value For Each celda In rangoCodigos codigo = celda.Value valor = hojaDatos.Cells(i, celda.Column).Value If Not IsEmpty(codigo) Then If IsNumeric(valor) Then valor = CDbl(valor) End If Print #archivoCSV, clave & "," & codigo & "," & valor & "," & mes & "," & año End If Next celda Next i Close archivoCSV MsgBox "Se ha generado el archivo CSV correctamente.", vbInformation End Sub Exportar datos a csv.xlsm2 points
-
Saludos @Paco Garrido Imagino que lo de no usar APILARV es por tu Excel 2021. Siendo así, esta es una opción ejemplo para 4 rangos (llamados _r1; _r2; _r3 y _r4): =LET( m; FILAS(_r1); n; FILAS(_r2); o; FILAS(_r3); p; FILAS(_r4); s; SECUENCIA(m + n + o + p); SI.CONJUNTO( s > m + n + o; INDICE(_r4; s - m - n - o); s > m + n; INDICE(_r3; s - m - n); s > m; INDICE(_r2; s - m); 1; INDICE(_r1; s) ) ) ¡Bendiciones!2 points
-
Private Sub CommandButton1_Click() Dim celda As Range For Each celda In Range("E1:E" & Cells(Rows.Count, "E").End(xlUp).Row) If IsNumeric(celda.Value) And celda.Value > 0 Then celda.HorizontalAlignment = xlLeft End If Next celda End Sub Numeros.xlsm2 points
-
1 point
-
1 point
-
1 point
-
Buenas te paso una forma. saludos actualizar tabla2_V1.xlsm1 point
-
Sub BuscarYListarHojas() Dim ruta As String Dim nombreLibro As String Dim libro As Workbook Dim hojaDestino As Worksheet Dim i As Integer Dim fd As FileDialog Dim rutaCompleta As String Set fd = Application.FileDialog(msoFileDialogFilePicker) fd.Title = "Seleccionar archivo" fd.Filters.Add "Archivos de Excel", "*.xls; *.xlsx; *.xlsm", 1 fd.AllowMultiSelect = False If fd.Show = -1 Then rutaCompleta = fd.SelectedItems(1) Else MsgBox "No se seleccionó ningún archivo.", vbExclamation Exit Sub End If On Error GoTo ErrorHandler Set libro = Workbooks.Open(rutaCompleta) On Error GoTo 0 Set hojaDestino = ThisWorkbook.Sheets("lista") hojaDestino.Cells.Clear For i = 1 To libro.Sheets.Count hojaDestino.Cells(i, 1).Value = libro.Sheets(i).Name Next i libro.Close False MsgBox "Hojas listadas exitosamente en la hoja 'lista'", vbInformation Exit Sub ErrorHandler: MsgBox "No se pudo abrir el libro especificado. Verifique el nombre y la ruta.", vbCritical End Sub Recuerde, para ejecutar debe extraer del ZIP AYUDA EXCEL.zip1 point
-
...................y bueno, si lo anterior sirve, creo que la 2ª fórmula (la de F5), puede simplificarse un tanto, dejándola así: =(261-E5)/45,625*DIA(FIN.MES(HOY();0))*C5 Saludos,1 point
-
Tal cual esta el código veras que ingresas un número de factura alfanumérico te dará error, intenta adaptarlo tu mismo y si no lo consigues consulta y lo modificamos1 point