Procedimiento demasiado grande en VBA Resuelto

Question

Hola,

Estoy trabajando en una programación en VBA. Acabo de terminar mi procedimiento, pero me aparece un mensaje de error que dice que mi procedimiento es demasiado grande.

Seguramente podría reducirlo, ya que hay cosas que se repiten, pero no sé cómo hacerlo.

¿Podrías ayudarme?

Gracias de antemano.

pijaku · Answer

Hola,
Sí, podemos ayudarte.
Sin embargo, sin archivo, sin el código, esto parece difícil...
Si el código es realmente demasiado largo, cópialo aquí parte por parte... ¡Veremos qué hacer!
De lo contrario, al menos cuéntanos qué se supone que debe hacer este código...
--
Atentamente,
Franck P

Chtitmiss · Answer

```html Sub Resultats()

'Declaración de las hojas de trabajo
Dim Donnees As Worksheet
Dim Resultats As Worksheet

Set Donnees = ActiveWorkbook.Worksheets("Donnees")
Set Resultats = ActiveWorkbook.Worksheets("Resultats")

'Declaración de las variables de la hoja "Donnees"
Dim mois As Range
Dim Sexe As Range
Dim sitfam As Range
Dim nbenf As Range
Dim age As Range
Dim act1 As Range
Dim act2 As Range
Dim ress1 As Range
Dim ress2 As Range
Dim logement As Range
Dim dec1 As Range
Dim dec2 As Range

'Cuenta el número de filas no vacías
Dim i As Integer
Dim num As Range
i = 1
Do
Set num = Donnees.Range("A" & i)
i = i + 1
Loop While num.Value <> ""
i = i - 2

'Uso del mes
Dim j As Integer
Dim m As Integer

'Sexo
Dim fem As Range
Dim hom As Range

'Situación familiar
Dim celib As Range
Dim coupleseul As Range
Dim persavecenf As Range
Dim coupleenf As Range

'Edad
Dim moins25 As Range
Dim entre2534 As Range
Dim entre3544 As Range
Dim entre4554 As Range
Dim entre5564 As Range
Dim plus65 As Range

'Actividad
Dim salarie As Range
Dim ddemploi As Range
Dim amm As Range
Dim inval As Range
Dim retraite As Range
Dim autre As Range

'Recursos
Dim salaire As Range
Dim assedic As Range
Dim RSA As Range
Dim PensionAlim As Range
Dim IJ As Range
Dim CAF As Range
Dim PIAAH As Range
Dim MVA As Range
Dim retr As Range
Dim sans As Range
Dim attente As Range

'Viviendas
Dim logpublic As Range
Dim logprive As Range
Dim heberge As Range
Dim logccas As Range
Dim autrelog As Range

'Decisiones
Dim st As Range 'Auxilio Terceros
Dim se As Range 'Ajustes de Efectivo
Dim scb As Range 'Ajustes de Cuenta Bancaria
Dim ts As Range 'Tickets de Servicio
Dim edf As Range
Dim gaz As Range
Dim avq As Range
Dim mutuelle As Range
Dim auberge As Range

'Programa para completar la tabla
For j = 1 To i

Set mois = Donnees.Range("B" & j)
Set Sexe = Donnees.Range("C" & j)
Set sitfam = Donnees.Range("E" & j)
Set nbenf = Donnees.Range("F" & j)
Set age = Donnees.Range("D" & j)
Set act1 = Donnees.Range("G" & j)
Set act2 = Donnees.Range("H" & j)
Set ress1 = Donnees.Range("I" & j)
Set ress2 = Donnees.Range("J" & j)
Set logement = Donnees.Range("K" & j)
Set dec1 = Donnees.Range("L" & j)
Set dec2 = Donnees.Range("M" & j)

'Enero
If mois.Value = "Janvier" Then
m = 3

'Sexo
Set fem = Resultats.Range("C" & m)
Set hom = Resultats.Range("B" & m)
If Sexe.Value = "F" Then
fem.Value = fem.Value + 1
Else
If Sexe.Value = "M" Then
hom.Value = hom.Value + 1
End If
End If

'Situación familiar
Set celib = Resultats.Range("E" & m)
Set coupleseul = Resultats.Range("F" & m)
Set persavecenf = Resultats.Range("G" & m)
Set coupleenf = Resultats.Range("H" & m)
If nbenf.Value = 0 Then
If sitfam.Value = "Seul" Then
celib.Value = celib.Value + 1
Else
If sitfam.Value = "Couple" Then
coupleseul.Value = coupleseul.Value + 1
End If
End If
Else
If nbenf.Value > 0 Then
If sitfam.Value = "Seul" Then
persavecenf.Value = persavecenf.Value + 1
Else
If sitfam.Value = "Couple" Then
coupleenf.Value = coupleenf.Value + 1
End If
End If
End If
End If

'Edad
Set moins25 = Resultats.Range("I" & m)
Set entre2534 = Resultats.Range("J" & m)
Set entre3544 = Resultats.Range("K" & m)
Set entre4554 = Resultats.Range("L" & m)
Set entre5564 = Resultats.Range("M" & m)
Set plus65 = Resultats.Range("N" & m)
If age.Value = "<25" Then
moins25.Value = moins25.Value + 1
Else
If age.Value = "25/34" Then
entre2534.Value = entre2534.Value + 1
Else
If age.Value = "35/44" Then
entre3544.Value = entre3544.Value + 1
Else
If age.Value = "45/54" Then
entre4554.Value = entre4554.Value + 1
Else
If age.Value = "55/64" Then
entre5564.Value = entre5564.Value + 1
Else
If age.Value = ">65" Then
plus65.Value = plus65.Value + 1
End If
End If
End If
End If
End If
End If
'
'Actividad
Set salarie = Resultats.Range("O" & m)
Set ddemploi = Resultats.Range("P" & m)
Set amm = Resultats.Range("Q" & m)
Set inval = Resultats.Range("R" & m)
Set retraite = Resultats.Range("S" & m)
Set autre = Resultats.Range("T" & m)
If act1.Value = "Salarié" Then
salarie.Value = salarie.Value + 1
Else
If act1.Value = "Demandeur d'emploi" Then
ddemploi.Value = ddemploi.Value + 1
Else
If act1.Value = "Arrêt maladie" Then
amm.Value = amm.Value + 1
Else
If act1.Value = "Invalidité" Then
inval.Value = inval.Value + 1
Else
If act1.Value = "Retraité" Then
retraite.Value = retraite.Value + 1
Else
autre.Value = autre.Value + 1
End If
End If
End If
End If
End If
If act2.Value <> "" Then
If act2.Value = "Salarié" Then
salarie.Value = salarie.Value + 1
Else
If act2.Value = "Demandeur d'emploi" Then
ddemploi.Value = ddemploi.Value + 1
Else
If act2.Value = "Arrêt maladie" Then
amm.Value = amm.Value + 1
Else
If act2.Value = "Invalidité" Then
inval.Value = inval.Value + 1
Else
If act2.Value = "Retraité" Then
retraite.Value = retraite.Value + 1
Else
autre.Value = autre.Value + 1
End If
End If
End If
End If
End If
End If

'Recursos
Set salaire = Resultats.Range("U" & m)
Set assedic = Resultats.Range("V" & m)
Set RSA = Resultats.Range("W" & m)
Set PensionAlim = Resultats.Range("X" & m)
Set IJ = Resultats.Range("Y" & m)
Set CAF = Resultats.Range("Z" & m)
Set PIAAH = Resultats.Range("AA" & m)
Set MVA = Resultats.Range("AB" & m)
Set retr = Resultats.Range("AC" & m)
Set sans = Resultats.Range("AD" & m)
Set attente = Resultats.Range("AE" & m)
If ress1.Value = "Salaire" Then
salaire.Value = salaire.Value + 1
Else
If ress1.Value = "ASSEDIC" Then
assedic.Value = assedic.Value + 1
Else
If ress1.Value = "RSA" Then
RSA.Value = RSA.Value + 1
Else
If ress1.Value = "Pension alimentaire" Then
PensionAlim.Value = PensionAlim.Value + 1
Else
If ress1.Value = "Indemnités Journalières" Then
IJ.Value = IJ.Value + 1
Else
If ress1.Value = "CAF" Then
CAF.Value = CAF.Value + 1
Else
If ress1.Value = "Pension d'invalidité" Or ress1.Value = "AAH" Then
PIAAH.Value = PIAAH.Value + 1
Else
If ress1.Value = "MVA" Then
MVA.Value = MVA.Value + 1
Else
If ress1.Value = "Retraite" Then
retr.Value = retr.Value + 1
Else
If ress1.Value = "Sans" Then
sans.Value = sans.Value + 1
Else
If ress1.Value = "En attente" Then
attente.Value = attente.Value + 1
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
If ress2.Value = "Salaire" Then
salaire.Value = salaire.Value + 1
Else
If ress2.Value = "ASSEDIC" Then
assedic.Value = assedic.Value + 1
Else
If ress2.Value = "RSA" Then
RSA.Value = RSA.Value + 1
Else
If ress2.Value = "Pension alimentaire" Then
PensionAlim.Value = PensionAlim.Value + 1
Else
If ress2.Value = "Indemnités Journalières" Then
IJ.Value = IJ.Value + 1
Else
If ress2.Value = "CAF" Then
CAF.Value = CAF.Value + 1
Else
If ress2.Value = "Pension d'invalidité" Or ress2.Value = "AAH" Then
PIAAH.Value = PIAAH.Value + 1
Else
If ress2.Value = "MVA" Then
MVA.Value = MVA.Value + 1
Else
If ress2.Value = "Retraite" Then
retr.Value = retr.Value + 1
Else
If ress2.Value = "Sans" Then
sans.Value = sans.Value + 1
Else
If ress2.Value = "En attente" Then
attente.Value = attente.Value + 1
End If
End If
End If
End If
End If
End If
End If
End If
End If
```

Chtitmiss · Answer

Porque ya hay una tabla creada para recibir los valores calculados y el procedimiento permite colocar los números directamente en los lugares previstos.

Chtitmiss · Answer

¿Entonces, cómo puedo hacerlo?

pijaku · Answer

Para:
Quizás entonces usando:
Application.WorksheetFunction.CountIf(Range(rango), datos)
Mira, este procedimiento debería contarte el número de mujeres y hombres:
En lugar de:

Dim Datos As Worksheet Dim Resultados As Worksheet Set Datos = ActiveWorkbook.Worksheets("Datos") Set Resultados = ActiveWorkbook.Worksheets("Resultados") Dim Sexo As Range Dim fem As Range Dim hom As Range If mes.Value = "Enero" Then m = 3 'Sexo Set Sexo = Datos.Range("C" & j) Set fem = Resultados.Range("C" & m) Set hom = Resultados.Range("B" & m) If Sexo.Value = "F" Then fem.Value = fem.Value + 1 Else If Sexo.Value = "M" Then hom.Value = hom.Value + 1 End If End If

Pones:

Sub ContarMujeresHombres() 'Declaración de variables Dim m As Integer Dim UltimaFila As Long 'se determina la última línea de la columna A y se almacena su número en la variable UltimaFila UltimaFila = Sheets("Datos").Range("A65536").End(xlUp).Row If mes.Value = "Enero" Then m = 3 'En la hoja "Resultados" With Sheets("Resultados") 'La celda C3 (3 depende del mes variable m) es igual al número de 'celdas de la hoja Datos, columna C que contienen "F" .Range("C" & m) = Application.WorksheetFunction.CountIf(Sheets("Datos").Range("C1:C" & UltimaFila), "F") .Range("B" & m) = Application.WorksheetFunction.CountIf(Sheets("Datos").Range("C1:C" & UltimaFila), "H") End With End Sub

Prueba eso y vuelve a vernos.
--
Atentamente,
Franck P

ccm81 · Answer

Hola
1. A la vista del código, debe haber manera de acortarlo, en particular, todos esos "if then else " anidados pueden ser ventajosamente reemplazados por "select case" más económicos y claramente más legibles
2. También puedes dividir el procedimiento Resultats en varios subprocedimientos
3. Creo que de todas formas, si quieres una ayuda más completa, deberás enviar el archivo (sin datos confidenciales, pero con algunos datos) a cijoint.fr en formato excel 2003 para que podamos aplicar
buena continuación

Procedimiento demasiado grande en VBA

6 respuestas

Problema de texturas en enshrouded

Color de los enlaces visitados en firefox 153

Tecla dañada del teclado logitech g915 (pieza original)

E.tre456.worm.windows

Impresora desinstalada

Seguridad de windows

Conexión de audio de pc, enchufes jack para cadena hi-fi

Problema de grabación y lectura de archivos jpg

Problema antivirus

Imposible ingresar mi número de teléfono en twitter