Leaderboard

Con lo fácil y bien que se ve 🤣: Function Suma(Celda As Range) As Double With Celda If .Value > 0 Then If .Offset(1) < 0 Then Suma = Suma + .Offset(1) If .Offset(2) < 0 Then Suma = Suma + .Offset(2) End If End With End Function

Que tal, verificando la consulta no veo necesidad de duplicar la Tabla de Reparto, dado que se puede simplemente agregar una columna (Importe total) con la siguiente fórmulación: =SUMAR.SI(Consumos!AR$2:AR$8;[@[Nombre completo]];Consumos!AK$2:AK$8)*[@[%]] Espero les sea útil.

Que tal a todos (y estimada Silvia), me permito hacer notar que la función BUSCAR realiza búsqueda por aproximación y por ello es muy sensible al cambio del orden de las fechas en la solución propuesta (al ordenar de menor a mayor por ejemplo). Dejo a consideración una solución alternativa que salva esta situación: =INDICE(Cond!F$1:F$7;AGREGAR(14;6;FILA(Cond!F$2:F$7)/((Cond!A$2:A$7=$AQ2)*(Cond!H$2:H$7<$AP2));1)) Espero les sea útil.

hola adjunto una opción Ejemplo consumos combustible sq.xlsx

Un nuevo formuliano a la vista 😍

Después de ver la solución de John Jairo V, corrijo mi propuesta: =SI(A1<0;0;SI(Y(A2<0;A3<0);A2+A3;SI(A2<0;A2;SI(A3<0;A3;0)))) Ambas soluciones funcionan igual, o sea, hemos entendido lo mismo, no obstante, por su sencillez, me quedaría con la de John.🙂

¡Saludos a todos! Una opción, según lo que se te entiende de este mensaje: Podrías usar, simplemente: =(A1>0)*SUMAR.SI(A2:A3;"<0") ¡Bendiciones!

La mía es mudarme de piso 😆😆

Hola ¿Y no haz pensado en una Tabla Dinámica? Estas son mas eficientes Te dejo una solución con formula =SUMAPRODUCTO(--(MES(Combustible[Fecha])=MES(FECHANUMERO(S$7&"/"&2022))),--(Combustible[Matrícula]=$C9),--Combustible[Venta]) Te en cuenta que SUMAPRODUCTO sobre miles de filas, puede ralentizar el calculo de la hoja

Hola, Probablemente sí es posible, y con dos premisas se simplificarían las soluciones (en principio, y si he entendido bien el problema). La primera premisa: tengo la sensación de que los datos de la columna A son celdas combinadas: eso me hace arrugar la nariz: tarde o temprano (más bien temprano) te va a dar problemas. Mejor si fuese posible repetir el número en cada una de las filas. Segunda premisa: debería haber un único rango de entrada (y otro de salida). El dato 3A, 1C, 2B,... debería introducirse en la columna E, por ejemplo, recogiéndose su espejo en la columna G, o viceversa; entradas en la columna G y salidas en la E. En una celda sólo puede haber un contenido: una fórmula o un dato (ambas cosas a la vez es imposible). Si no, habrá que recurrir indefectiblemente (me temo) a Macros. Estos indicadores que te expongo, ¿son negociables?

Saludos @jesuspg Esto es porque estás usando la función MES dentro de la función TEXTO. si la quitas, tendrás el nombre del mes correcto: =SI(ESBLANCO([@[FECHA DE LA COMUNICACION]]);"";MAYUSC(TEXTO([@[FECHA DE LA COMUNICACION]];"MMMM"))) ¡Bendiciones!

Hola, Entiendo que es solo buscar la placa que corresponde al comodin. Adjunto Archivo Ejemplo consumos combustible sq.xlsx

Prueba así a ver si te vale: Private Sub CargarLista() Dim x As Long, Nombre As Range CmbID.Clear For x = 28 To Hoja4.Range("E28").End(xlDown).Row CmbID.AddItem Hoja4.Range("E" & x) Set Nombre = Hoja2.Columns("A").Find(Hoja4.Range("E" & x), , , xlWhole) If Not Nombre Is Nothing Then CmbID.List(CmbID.ListCount - 1, 1) = UCase(Nombre.Offset(, 1)) '<------ CmbID.List(CmbID.ListCount - 1, 2) = Hoja4.Range("F" & x).Text Next TxtTotalR.Text = FormatNumber(Hoja4.Range("F26"), 2) For x = 0 To CmbID.ListCount - 1 If CmbID.List(x, 2) = "" Then CmbID.ListIndex = x Exit For End If Next End Sub

EL error que te da es porque tanto la cuenta 4600030018 como la 4600050018 no las tienes en la hoja auxiliar por lo que no es posible asignarle su nombre, añade dichas cuentas y prueba.

Si te refieres a la formula, así empezamos todos jaja Vamos saca ese deseo de tu interior 😄

=SI(A1<=0;0;SI(Y(A2<=0;A3<=0);A2+A3;SI(A2<=0;A2;SI(A3<=0;A3;0))))

Buenas tardes reiteradas. Gracias Víctor y Gracias Gerson. Entiendo perfectamente lo que ustedes plantean, estamos de acuerdo, lo que sucede es que esos Modelos están estandarizados en nuestro sistema y no permiten modificarlos, de hecho estos modelos están hechos para llenarlos "a mano", o sea, en la era de hielo, o en el paleolítico superior, porque acá la informatización en las empresas es un problema serio (bueno, acá todo es un problema), pero si tengo las "Herramientas" y sé cómo usarlas, trato de pasar el menor trabajo posible y optimizarlo, por eso es que "construyo" estos "intentos" de programas en VBA, porque indudablemente los formularios ayudan mucho al momento de trabajar con base de datos. Siempre me he referido al agradecimiento que les tengo a todos ustedes por la inmensa ayuda que recibo y las cosas que aprendo. No paso por alto sus recomendaciones y soluciones, sólo que estoy "atado" de mano porque en este caso específico no puedo hacerle ninguna modificación a los modelos. Siéntanse útiles con lo que hacen, porque así yo lo veo y de una u otra manera siempre ayudan, siempre resuelven un problema, siempre nos enseñan y algo que desde mi punto de vista creo, reforzamos nuestra amistad, nuestra confianza, porque aunque estemos lejos geográficamente, yo los siento cerca desde el punto de vista humano, y no solo a ustedes dos, sino al profesor Antoni, al profesor JSD, a Abrahan Valencia, a Haplox, JasBall, a Raigosa, a DiegoPC y muchos otros que en determinado momento me han tendido su mano y me han ofrecido su ayuda de una manera desinteresada y eso yo lo agradezco infinitamente. Un gran abrazo para todos. Mis respetos Pino

Otra forma Sub EncabezadoArrayII() Dim MyArray As Variant MyArray = Range("A1", Cells(1, Columns.Count).End(xlToLeft)) End Sub En este caso el array es de 2 dimensiones por lo que te has de referir a un elemento así: MyArray(1, c) siendo c el número de columna. En cualquier caso, puede que el array sea innecesario, basta con recorrer la fila 1 con: For y = 1 To Cells(1, Columns.Count).End(xlToLeft).Column ... ... Next

Hola, Me parece excelente; encuentro la idea muy brillante. Saludos,

Y por supuesto debes seguir los consejos que te da el Maestro Antoni.

En el archivo que has subido no hay datos, por lo que el ejemplo que has puesto es imposible de analizar. Tampoco especificas cual es el formulario en el que hay que actuar. A veces el exceso de explicaciones solo deriva en la perdida de interés en la persona que podría ayudarte y si además no especificamos claramente cuales son los elementos que intervienen en el problema, las posibilidades de ayuda se reducen enormemente. Por último, debes facilitar las cosas a quien te quiera ayudar, en el adjunto, debes eliminar el control de acceso al abrir el archivo y debes quitar la contraseña al proyecto VBA.

Buenas. No sé si eso es lo que quieres, pero ahí va. He añadido una columna en Combustible para que te dé el mes (esa la puedes ocultar). A partir de ahí, ya tienes la fórmula introducida. Solo debes ponerla en cada mes. Saludos. Sistema de Matto v5.4.2 Formula.xlsm

Ya pareces... ya sabes quién jajaja.

Hola No, Excel no cuenta con una función de ese tipo, las alternativas son el uso de macros o tener Excel 365 y su herramienta "Traducir" la cual no te envía el resultado a las celdas.

Hola Reemplaza tu código por este otro Dim C As Control For Each C In Me.Controls If TypeName(C) = "Label" Then C.BackStyle = fmBackStyleTransparent Next

Hola En el supuesto que tengas Office 2019, 2021 o 365, esta es una de varias alternativas. De tener una versión menor de Excel, comenta para ver alternativas que funcionen en ellas. Saludos. Lista_horarios.xlsx

Yo tengo Excel 2016el de 64bits Y uso este código Creas un modulo y metes este código Option Explicit Type POINTAPI x As Long y As Long End Type Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Type MSLLHOOKSTRUCT pt As POINTAPI mouseData As Long flags As Long time As Long dwExtraInfo As Long End Type #If VBA7 Then #If Win64 Then Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal Point As LongPtr) As LongPtr #Else Declare PtrSafe Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As LongPtr #End If Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Declare PtrSafe Function GetParent Lib "user32" (ByVal hwnd As LongPtr) As LongPtr Declare PtrSafe Function GetActiveWindow Lib "user32" () As LongPtr Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr) Declare PtrSafe Function GetCursorPos Lib "user32" (ByRef lpPoint As POINTAPI) As LongPtr Declare PtrSafe Function SetFocus Lib "user32" (ByVal hwnd As LongPtr) As LongPtr Declare PtrSafe Function IsWindow Lib "user32" (ByVal hwnd As LongPtr) As Long Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, ByVal dwThreadId As Long) As LongPtr Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, ByVal nCode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As LongPtr Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As RECT) As Long Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Dim hwnd As LongPtr, lMouseHook As LongPtr #Else Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long Declare Function GetActiveWindow Lib "user32" () As Long Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) Declare Function GetCursorPos Lib "user32" (ByRef lpPoint As POINTAPI) As Long Declare Function SetFocus Lib "user32" (ByVal hwnd As Long) As Long Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, ByVal nCode As Long, ByVal wParam As Long, lParam As Any) As Long Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Dim hwnd As Long, lMouseHook As Long #End If Const WH_MOUSE_LL = 14 Const WM_MOUSEWHEEL = &H20A Const HC_ACTION = 0 Const WM_LBUTTONDOWN = &H201 Const WM_LBUTTONUP = &H202 Const MK_LBUTTON = &H1 Const SM_CXVSCROLL = 2 Sub SetComboBoxHook(ByVal Control As Object) Dim tpt As POINTAPI Dim sBuffer As String Dim lRet As Long If lMouseHook = 0 Then GetCursorPos tpt #If VBA7 And Win64 Then Dim lPt As LongPtr CopyMemory lPt, tpt, LenB(tpt) hwnd = WindowFromPoint(lPt) #Else hwnd = WindowFromPoint(tpt.x, tpt.y) #End If sBuffer = Space(256) lRet = GetClassName(GetParent(hwnd), sBuffer, 256) If InStr(Left(sBuffer, lRet), "MdcPopup") Then SetFocus hwnd #If VBA7 Then lMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, Application.HinstancePtr, 0) #Else lMouseHook = SetWindowsHookEx(WH_MOUSE_LL, AddressOf MouseProc, Application.Hinstance, 0) #End If End If End If End Sub Sub RemoveComboBoxHook() UnhookWindowsHookEx lMouseHook: lMouseHook = 0 End Sub #If VBA7 Then Function MouseProc(ByVal nCode As Long, ByVal wParam As LongPtr, lParam As MSLLHOOKSTRUCT) As LongPtr #Else Function MouseProc(ByVal nCode As Long, ByVal wParam As Long, lParam As MSLLHOOKSTRUCT) As Long #End If Dim sBuffer As String Dim lRet As Long Dim tRect As RECT sBuffer = Space(256) lRet = GetClassName(GetActiveWindow, sBuffer, 256) If Left(sBuffer, lRet) = "wndclass_desked_gsk" Then Call RemoveComboBoxHook If IsWindow(hwnd) = 0 Then Call RemoveComboBoxHook If (nCode = HC_ACTION) Then If wParam = WM_MOUSEWHEEL Then #If VBA7 And Win64 Then Dim lPt As LongPtr Dim Low As Integer, High As Integer Dim lParm As LongPtr CopyMemory lPt, lParam.pt, LenB(lPt) If WindowFromPoint(lPt) = hwnd Then #Else Dim Low As Integer, High As Integer Dim lParm As Long If WindowFromPoint(lParam.pt.x, lParam.pt.y) = hwnd Then #End If GetClientRect hwnd, tRect If lParam.mouseData > 0 Then Low = tRect.Right - (GetSystemMetrics(SM_CXVSCROLL) / 2) High = tRect.Top + ((GetSystemMetrics(SM_CXVSCROLL) / 2) + 1) lParm = MakeDWord(Low, High) Else Low = tRect.Right - (GetSystemMetrics(SM_CXVSCROLL) / 2) High = tRect.Bottom - ((GetSystemMetrics(SM_CXVSCROLL) / 2) + 1) lParm = MakeDWord(Low, High) End If PostMessage hwnd, WM_LBUTTONDOWN, MK_LBUTTON, lParm PostMessage hwnd, WM_LBUTTONUP, MK_LBUTTON, lParm End If End If End If MouseProc = CallNextHookEx(lMouseHook, nCode, wParam, ByVal lParam) End Function Private Function MakeDWord(ByVal LoWord As Integer, ByVal HiWord As Integer) As Long MakeDWord = (HiWord * &H10000) Or (LoWord And &HFFFF&) End Function y ya luego en el userform metes este código llamando a cada uno de tus listbox o combobox en el que quieras usar el desplazamiento por la rueda del ratón Private Sub ComboBox_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single) Call SetComboBoxHook(ComboBox) End Sub Private Sub ComboBox_LostFocus() Call RemoveComboBoxHook End Sub Private Sub ComboBox_Change() 'change event not affected by the hook. End Sub

Sin archivo, imposible ayudarte.

Prueba a ver si es esto lo que buscas: Sub Prueba_Ytb_2() Dim FileToOpen As Variant Dim OpenBook As Workbook Application.ScreenUpdating = False FileToOpen = Application.GetOpenFilename(Title:="Seleccionar archivo", FileFilter:="Excel Files(*.xls*),*xls*") If FileToOpen <> False Then Set OpenBook = Application.Workbooks.Open(FileToOpen) OpenBook.Sheets(7).Range("C6:K" & OpenBook.Sheets(7).Range("C" & Rows.count).End(xlUp).Row).Copy ThisWorkbook.Worksheets("Hoja1").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues OpenBook.Close End If Application.ScreenUpdating = True End Sub

También: Sub fecha_inicio() anyo = Year(Sheets("Repsol").Range("B1")) mes = Format(Month(Sheets("Repsol").Range("B1")), "00") dia = Format(Day(Sheets("Repsol").Range("B1")), "00") Sheets("Repsol").Range("B2") = anyo & mes & dia End Sub

Hola chicos, gracias por vuestras respuestas, me han sido muy clarificadoras. Gracias Abraham, veo que vba Excel no es todopoderoso, no lo puede hacer todo. Bueno, he encontrado la solución, y es la que me ha dado DiegoPC, ya lo habia pensado antes, pero el me lo ha confirmado. Gracias Diego a ti tambien. La unica diferencia es que no le reprocho nada al que quiere restaurar la ventana, jajajaja. Cuando vea que no puede, ya se rendirá 🤣🤣 Un saludo chicos... 🙂

Lo sé, yo solo te mande el aviso para que intentaras tú mismo solucionarlo, pero el Maestro Antoni te dio la solución un saludo a ambos.

Tranquilo, no lo comentaba directamente por ti, si no que es una tendencia sobre los usuarios Gracias por tus muestras de agradecimiento, dice mucho de ti Saludos!

No tienes que pedir disculpas, simplemente son consejos para que puedas recibir ayuda a tus consultas.

Y por si a caso, utilizas esta formula, para los siguientes años Una leve modificación respecto a la primera, es que no será necesario modificar/introducir el año Quedando así: =SUMAPRODUCTO(--(MES(Combustible[Fecha])=MES(FECHANUMERO(1&"/"&S$7))),--(Combustible[Matrícula]=$C9),--Combustible[Venta]) Por cierto en esa hoja ciertos meses les colocaste punto al final del nombre del mes, estandarízalo a 3 letras y sin el punto

Yo lo solventé con formula FILTRAR, en vez de las tablas esas, porque me resultaba tambien muchísimo trabajo. Hice unas consultas, que van dependiendo de los niveles que haga falta, con FILTRAR. Es decir, en un campo auxiliar, hice que se filtraran datos segun lo seleccionado en una casilla anterior, luego, traía los datos seleccionados con validación de datos. Y así, hasta 4 o lo que haga falta. Saludos,

Hola a todos gracias por dejarme participar en el foro. Soy Alex aún aprendiendo básicos de excel. Saludos.

Aquí lo tienes Prueba.xlsm

Creo que @JasallBcn preguntaba por la versión del solicitante (quien abrió este hilo) y no de @Antoni casi me caigo como el popular Condorito, jajajaja

Hola, Hablando del "engendro", hay quienes quieren o necesitan seguir con el, por temas visuales y en casos como este hasta es posible conservarlo, no quiere decir que sea lo mejor, pero de que se puede, se puede. Ahora entrando en el tema, como dice @Victor7, en una celda o hay valores o hay formulas, y el método es usar otra zona de digitación y con funciones ponemos el resultado en la zona del informe. Adjunto una propuesta, me parece que funciona, seguramente necesitará mejoras en el archivo final, lo que quiero es compartir la idea, respetando el "engendro", aunque no siempre es lo mejor. Hay me van contando sus opiniones. Saludos. El engendro.xlsx

Hola de nuevo, Creo haber encontrado un método que nos va a permitir burlar el monopolio 'Macros' para este problema concreto. Aunque se necesita algún cambio cosmético. Veamos esta imagen, simplificada del modelo (he respetado las filas y columnas del mismo) : Lo primero, como comenté anteriormente, sería completar la numeración de la columna A en todas las filas, huyendo de ese engendro conocido como 'celdas combinadas'. Y lo segundo sería introducir los datos de entrada manuales en un rango diferente: en este caso, J5:K24. He puesto 2 ejemplos en J7 y en K9 para verificar la corrección del resultado. Y ahora las fórmulas. En E6 introduciremos ésta: =SI(J6<>"";J6;SI.ND(DESREF(A$5;COINCIDIR(A6&C6;K$6:K$24;);)&DESREF(C$5;COINCIDIR(A6&C6;K$6:K$24;););"")) Y en G6 esta otra: =SI(K6<>"";K6;SI.ND(DESREF(A$5;COINCIDIR(A6&C6;J$6:J$24;);)&DESREF(C$5;COINCIDIR(A6&C6;J$6:J$24;););"")) Copiaremos ambas verticalmente hasta la fila 24, para completar el rango de resultados. Y con eso, en principio, se resuelve tu problema, si no voy equivocado. Ve introduciendo datos en cualquiera de las columnas J o K, y esas coordenadas con sus correspondientes espejos deberían ir apareciendo en su sitio. A ver si hay suerte... Saludos,

Nota: Por orden de "la jefa" (ella Sabe quIén es, literaLmente 😂🤣)... y claramente, para el consultante y todos los interesados, informo que la fórmula de fondo gris es de introducción matricial. Es decir, no se debe introducir con un simple Enter, sino con Control + Shift + Enter (CSE). ¡Bendiciones!

Hola Disculpa pero no se entiende nada y más parece una tarea que te han dejado. Sugiero tratar de explicar mejor y un punto a la vez si quieres recibir ayuda.

Muchas gracias estimado @GabrielRaigosa por tan valioso aporte! Saludos desde Paraguay!

Gracias @Gerson Pineda y @Antoni por sus aportaciones ya se soluciono saludos

Resuelto aquí: https://foro.todoexcel.com/threads/macros-deshabilitadas.63320/ Autorizar macros en una carpeta: Autorizar macros en un archivo:

Pues no lo entiendo........ a mí me funciona perfectamente. He hecho nuevos añadidos y los reconoce perfectamente. A ver si tienes activado el recálculo manual..... si es así, tienes que pulsar F9 para refrescar datos –?– Ejemplo2 (C).xlsx

Muchas gracias ahora si me hace lo que quiero 🥰

Excelente, muy buena adaptación. Por cierto, eliminaré el otro mensaje relacionado ¿Está bien? Saludos.

Hola Disculpa, pero no entiendo a que exactamente te refieres con tu duda Inserta un mini video de ese comportamiento de tu PBI, para entender con mas claridad