2 PROCESSES IN VBA MACROS THAT SHOULD NOT HAPPEN

leobrice

New Member
Joined
Jun 14, 2024
Messages
37
Office Version
  1. 2013
Platform
  1. Windows
Saludos amigos de MREXCEL, buenas noches.

El archivo se utiliza para calcular costos de productos y servicios, y las macros automatizan el proceso de cálculos y trámites, sin embargo, tiene 2 fallas.

Te explico como funciona:

HOJA DE COSTOS PRODUCTOS NACIONALES:

Registre información sobre productos y servicios nacionales, e incluye:

A= Producto o Servicio
B= NACIONAL
C= Unidad de medida
D= Cantidad de producto
E= Monto total de compra
F y G= (fórmula) Costo unitario por unidad de medida

La Macro envía la información del producto (columnas A y B) a la hoja PRECIOS PRODUCTOS Y SERVICIOS al completar el Monto Total de Compra (E).

COSTOS DE SERVICIOS (en este ejemplo HOJA DE LIMPIEZA:

Registre información detallada de los servicios nacionales y se divide en 2 bloques. Uno para los productos utilizados para brindar un servicio y otro para registrar las horas hombre utilizadas para brindar el servicio.

Al confirmar la información del servicio, colocando SÍ en E61, la macro envía los datos contenidos en la fila 62 a la hoja COSTOS PRODUCTOS NACIONALES:

A= Nombre del Servicio a la columna A
B= Unidad de Medida Servicio a la columna C
C= Cantidad de Servicio a la columna D igual a 1
E= Costo Total del Servicio a la columna E

Cuando la información llega a la hoja COSTOS PRODUCTOS NACIONALES, la macro de esta hoja se activa y envía la información de este servicio (columnas A y B) a la hoja PRECIOS PRODUCTOS Y SERVICIOS ya que el costo total del servicio de la columna E descrito anteriormente.

FICHA DE PRECIOS PRODUCTOS Y SERVICIOS:

Aquí se registra la información de productos y servicios nacionales para calcular el precio.

La información de productos y servicios proviene de la ficha COSTOS PRODUCTOS NACIONALES y es:

A = Nombre del Producto o Servicio
B= NACIONAL.

El resto de la hoja se maneja llenando información en algunas columnas y el resto es fórmula.

Hay 2 problemas con las macros y esto es lo que quiero resolver:

1. En la hoja COSTOS DE SERVICIOS, si quiero actualizar el precio de cualquier componente del servicio, la macro actualiza el precio del servicio en la hoja COSTOS PRODUCTOS NACIONALES, pero envía la información del servicio nuevamente a PRECIOS PRODUCTOS Y SERVICIOS como una nueva. , ya que actualizaste el valor de la columna E y ejecutaste la macro nuevamente. No puede ser.

2. En la hoja de COSTOS PRODUCTOS NACIONALES, si actualiza el costo de algún producto previamente registrado, ejecute nuevamente la macro, enviando el último producto registrado a PRECIOS PRODUCTOS Y SERVICIOS. No puede ser.

Agradecería mucho su ayuda para corregir estos 2 eventos que no deberían suceder.

EXAMPLE MACROS - Copy.xlsm
ABCDEFG
1ABC Ltda
2COSTOS DE PRODUCTOS Y SERVICIOS NACIONALES
3PRODUCTO / SERVICIONACIONALUNIDAD DE MEDIDACANTIDAD DE PRODUCTOMONTO TOTAL DE LA COMPRACOSTO PRODUCTO UNITARIO
4
5PRODUCTO 1NACIONALKilo1.000,00100.000,00100,00por Kilo
6PRODUCTO 2NACIONALKilo1.000,00200.000,00200,00por Kilo
7PRODUCTO 3NACIONALKilo1.000,00300.000,00300,00por Kilo
8PRODUCTO 4NACIONALKilo1.000,00400.000,00400,00por Kilo
9PRODUCTO 5NACIONALKilo1.000,00500.000,00500,00por Kilo
10PRODUCTO 6NACIONALKilo1.000,00600.000,00600,00por Kilo
11PRODUCTO 7NACIONALKilo1.000,00700.000,00700,00por Kilo
12PRODUCTO 8NACIONALKilo1.000,00800.000,00800,00por Kilo
13PRODUCTO 9NACIONALKilo1.000,00900.000,00900,00por Kilo
14PRODUCTO 10NACIONALKilo1.000,001.000.000,001.000,00por Kilo
15LIMPIEZANACIONALServicio1,001.250.000,001.250.000,00por Servicio
16NACIONAL0,000
17NACIONAL0,000
COSTOS PRODUCTOS NACIONALES
Cell Formulas
RangeFormula
A1A1='INFORMACION GENERAL'!D5
F5:F17F5=IFERROR(E5/D5,0)
G5:G17G5=C5
Cells with Conditional Formatting
CellConditionCell FormatStop If True
G5:G10000Cell Value=0textNO
Cells with Data Validation
CellAllowCriteria
A5:B10000Custom=CONTAR.SI($A$5:$A$10000;A5)<=1
C5:C10000List=UNIDADES
E5:E14Custom=CONTAR.SI($A$5:$A$10000;E5)<=1
E15:E10000Any value


EXAMPLE MACROS - Copy.xlsm
ABCDE
1ABC Ltda
2COSTOS DE SERVICIOS
3NOMBRE SERVICIO PRESTADO:UNIDAD DE MEDIDACANTIDAD DE PRODUCTO HORASCOSTO UNITARIO COMPONENTETOTAL COSTO
4LIMPIEZA
5COMPONENTES DEL SERVICIO
6PRODUCTOS Y SERVICIOS
7ACETONA 2500500,001.250.000,00
8 10,000,00
9 60,000,00
10 10,000,00
11 120,000,00
12 0,000,00
13 0,000,00
14 0,000,00
15 0,000,00
16 0,000,00
17 0,000,00
18 0,000,00
19 0,000,00
20 0,000,00
21 0,000,00
22 0,000,00
23 0,000,00
24 0,000,00
25 0,000,00
26 0,000,00
27 0,000,00
28 0,000,00
29 0,000,00
30 0,000,00
31 0,000,00
32 0,000,00
33 0,000,00
34 0,000,00
35 0,000,00
36 0,000,00
37TOTAL COSTOS DE PRODUCTOS Y SERVICIOS PARA LIMPIEZA1.250.000,00
38HORAS HOMBRE
39LEONARDO BRICEÑOHoras Hombre400,000,00
40Horas Hombre0,000,00
41Horas Hombre0,000,00
42Horas Hombre0,000,00
43Horas Hombre0,000,00
44Horas Hombre0,000,00
45Horas Hombre0,000,00
46Horas Hombre0,000,00
47Horas Hombre0,000,00
48Horas Hombre0,000,00
49Horas Hombre0,000,00
50Horas Hombre0,000,00
51Horas Hombre0,000,00
52Horas Hombre0,000,00
53Horas Hombre0,000,00
54Horas Hombre0,000,00
55Horas Hombre0,000,00
56Horas Hombre0,000,00
57Horas Hombre0,000,00
58Horas Hombre0,000,00
59TOTAL COSTOS DE HORAS HOMBRE PARA LIMPIEZA0,00
60TOTAL GENERAL LIMPIEZA1.250.000,00
61CONFIRMAR COSTO DE ESTE SERVICIO PARA PROCESARLO (SI/NO)SI
62LIMPIEZAServicio11.250.000,00
63
LIMPIEZA
Cell Formulas
RangeFormula
A1A1='INFORMACION GENERAL'!D5
A4A4=MID(CELL("filename",A1),1+SEARCH("]",CELL("filename",A1)),100)
E39:E58,E7:E36E7=C7*D7
D8:D36D8=IFERROR(VLOOKUP(A8,'PRECIOS PRODUCTOS Y SERVICIOS'!$A$6:$W$134,23,0),0)
B7:B36B7=IFERROR(VLOOKUP(A7,'PRECIOS PRODUCTOS Y SERVICIOS'!A6:W136,3,0)," ")
A37A37=CONCATENATE("TOTAL COSTOS DE PRODUCTOS Y SERVICIOS PARA ",A4)
E37E37=SUM(E7:E36)
D39:D58D39=IFERROR(VLOOKUP(A39,#REF!,12,0),0)
A59A59=CONCATENATE("TOTAL COSTOS DE HORAS HOMBRE PARA ",A4)
E59E59=SUM(E39:E58)
A60A60=CONCATENATE("TOTAL GENERAL ",A4)
E60E60=E37+E59
A62A62=A4
E62E62=E60
Cells with Conditional Formatting
CellConditionCell FormatStop If True
E61Cell Value="SI"textNO
E61Cell Value="NO"textNO
Cells with Data Validation
CellAllowCriteria
A39:A58List=HORAS_HOMBRE
A7:A36List=PRECIOS_PRODUCTOS


EXAMPLE MACROS - Copy.xlsm
ABCDE
1ABC Ltda
2PRECIO DE VENTA DE PRODUCTOS Y SERVICIOS
3PRODUCTO / SERVICIONACIONAL o IMPORTADOUNIDAD DE MEDIDACOSTO UNITARIO PRODUCTOVENTAS ESTIMADAS MENSUALES UNIDADES
4
50
6PRODUCTO 1NACIONALKilo100,00
7PRODUCTO 2NACIONALKilo200,00
8PRODUCTO 3NACIONALKilo300,00
9PRODUCTO 4NACIONALKilo400,00
10PRODUCTO 5NACIONALKilo500,00
11PRODUCTO 6NACIONALKilo600,00
12PRODUCTO 7NACIONALKilo700,00
13PRODUCTO 8NACIONALKilo800,00
14PRODUCTO 9NACIONALKilo900,00
15PRODUCTO 10NACIONALKilo1.000,00
16LIMPIEZANACIONALServicio1.250.000,00
17LIMPIEZANACIONALServicio1.250.000,00
18
19
PRECIOS PRODUCTOS Y SERVICIOS
Cell Formulas
RangeFormula
A1A1='INFORMACION GENERAL'!D5
E5E5=SUM(E6:E9999)
C6:C19C6=IFERROR(IF(B6="NACIONAL",VLOOKUP(A6,'COSTOS PRODUCTOS NACIONALES'!$A$5:$G$10000,3,0),VLOOKUP(A6,#REF!,3,0))," ")
D6:D19D6=IFERROR(IF(B6="NACIONAL",VLOOKUP(A6,'COSTOS PRODUCTOS NACIONALES'!$A$5:$G$10000,6,0),VLOOKUP(A6,#REF!,23,0))," ")
Cells with Data Validation
CellAllowCriteria
A16:A19Custom=CONTAR.SI($A$5:$A$9999;A16)<=1
A6:B15Custom=CONTAR.SI($A$5:$A$10000;A6)<=1
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
These are the macros of the excel sheets

HOJA DE COSTOS PRODUCTOS NACIONALES VBA

Hoja de trabajo secundaria privada_Cambio de selección (objetivo ByVal como Excel.Range)

Me.Name = "COSTOS PRODUCTOS NACIONALES"
Subtítulo final

Sub EnviarDatosCostosProductosNacionalesAPreciosProductosYSServiciosA()
Aplicación.ScreenUpdating = Falso

Dim ult, ult1 siempre y cuando
Rango de atenuación según rango
ult2 = Sheets("COSTOS PRODUCTOS NACIONALES").Range("A" & Rows.Count).End(xlUp).Row
ult3 = Hojas("COSTOS PRODUCTOS NACIONALES").Range("B" & Rows.Count).End(xlUp).Row

ult = Sheets("PRECIOS PRODUCTOS Y SERVICIOS").Range("A" & Rows.Count).End(xlUp).Fila + 1
ult1 = Hojas("PRECIOS PRODUCTOS Y SERVICIOS").Rango("B" & Filas.Cuenta).End(xlArriba).Fila + 1

Aplicación.ScreenUpdating = Falso
Hojas("PRECIOS PRODUCTOS Y SERVICIOS").Rango("B" & ult1) = Hojas("COSTOS PRODUCTOS NACIONALES").Rango("B" & ult3).Valor
Hojas("PRECIOS PRODUCTOS Y SERVICIOS").Rango("A" & ult1) = Hojas("COSTOS PRODUCTOS NACIONALES").Rango("A" & ult2).Valor

Hojas("PRECIOS PRODUCTOS Y SERVICIOS").Seleccione

MsgBox ("SE HA ENVIADO AL MODULO PRECIOS PRODUCTOS Y SERVICIOS, LA INFORMACIÓN DE ESTE PRODUCTO O SERVICIO." & Chr(13) & _
"POR FAVOR COMPLETA LA INFORMACIÓN SOLICITADA" & Chr(13) & _
"!OPERACIÓN REALIZADA SATISFACTORIAMENTE¡"), vbInformation, "CALCULADORA DE PRECIOS Y COSTOS DATCHEL PLUS"



Hojas("PRECIOS PRODUCTOS Y SERVICIOS").Rango("E" & ult1).Seleccione

Subtítulo final
Hoja de trabajo secundaria privada_Cambio (objetivo por valor como rango)
Si Target.Row> 5 entonces
Si Target.Address es como "$E$*" entonces
Si Rango("E" y Target.Row) > 0 Entonces
Aplicación.ScreenUpdating = Falso
Llamar EnviarDatosCostosProductosNacionalesAPreciosProductosYServiciosA
Terminara si
Terminara si
Terminara si

Dim prod$, ovni&, ufd&
Dim pro_d como rango
Dim rDependents como rango

uf = Rango("C" & Filas.Cuenta).Fin(xlArriba).Fila
'prod = TempCombo
prod = Rango("A" y Objetivo.Fila).Valor

Si Application.Intersect(Target, Range("C5:C" & uf)) no es nada y _
Application.Intersect(Target, Range("D5:D" & uf)) no es nada y _
Application.Intersect(Target, Range("E5:E" & uf)) Entonces no es nada
Salir Sub
Terminara si

Si Worksheets("COSTOS PRODUCTOS NACIONALES").Range("F" & Target.Row).Value > 0 Entonces
Con Hojas("PRECIOS PRODUCTOS Y SERVICIOS")
ufd = .Range("A" & Rows.Count).End(xlUp).Row
Establecer pro_d = .Range("A5:A" & ufd).Buscar(prod)
pro_d.Offset(, 1) = Hojas de trabajo("COSTOS PRODUCTOS NACIONALES").Rango("B" & Target.Row).Valor
Terminar con
Terminara si


Subtítulo final

HOJA DE LIMPIEZA VBA
Hoja de trabajo secundaria privada_Cambio (objetivo por valor como rango)
Si Target.CountLarge > 1, entonces salga de Sub
Si Intersect(Target, Range("C:C,D:D,E61")) no es nada, entonces salga de Sub
Aplicación.ScreenUpdating = Falso
Atenuar buscar como rango
Seleccionar caso verdadero
Destino del caso. Dirección = "$E$61"
Si objetivo = "SI" entonces
Con Hojas("COSTOS PRODUCTOS NACIONALES")
.Cells(.Rows.Count, "A").End(xlUp).Offset(1) = Target.Offset(1, -4)
.Cells(.Rows.Count, "C").End(xlUp).Offset(1) = Target.Offset(1, -3)
.Cells(.Rows.Count, "D").End(xlUp).Offset(1) = Target.Offset(1, -2)
.Cells(.Rows.Count, "E").End(xlUp).Offset(1) = Target.Offset(1)
Terminar con
Terminara si
Destino del caso. Dirección como "*D*"
Set fnd = Sheets("COSTOS PRODUCTOS NACIONALES").Range("A:A").Find(Range("A62").Value, LookIn:=xlValues, lookat:=xlWhole)
Si no lo encuentro no es nada entonces
fnd.Offset(, 4) = Rango("E62")
Terminara si
Destino del caso. Dirección como "*C*"
Set fnd = Sheets("COSTOS PRODUCTOS NACIONALES").Range("A:A").Find(Range("A62").Value, LookIn:=xlValues, lookat:=xlWhole)
Si no lo encuentro no es nada entonces
fnd.Offset(, 4) = Rango("E62")
Terminara si
Finalizar selección
Aplicación.ScreenUpdating = Verdadero
Subtítulo final
 
Upvote 0
Si no recibes ninguna respuesta, utiliza DeepL para traducir al inglés. Mantén tus preguntas cortas y directas. Divida los problemas complejos en porciones manejables y tal vez encuentre la solución allí.
If you are not getting any answers, use deepL to translate into English.

Keep you questions short and to the point.

Break down the complex problems into ore manageable portions and maybe you will find the solution there.
 
Upvote 0

Forum statistics

Threads
1,223,214
Messages
6,170,772
Members
452,353
Latest member
strainu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top