Erreur d'exécution Paste et plantage Excel

Le 13/05/2013 à 16:59

Bonjour, je viens vers vous pour essayer de trouver une solution à mon probleme. Aprés pas mal de recherche, je n'ai toujours pas réussi à trouver une solution. Ma macro fonctionne en pas à pas détaillé mais excel plante lorsque je la lance normalement.

Le but de la macro est d'analyser un tableau à double entrée et de regrouper par la suite les informations.

Voici le code que j'ai écris.

Sub macrowbs()

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

Dim i As Integer

Dim j As Integer

Dim k As Integer

Dim n As Integer

Dim p As Integer

Dim m As Integer

Dim x As Integer

p = 5

n = 1

x = 1

d = 0

Sheets("Taches").Select

Range("A2:J1000").Select

Selection.ClearContents

Sheets("Zone").Select

For j = 7 To 20

If Cells(j, 2) <> "" Then

For i = 4 To 30

If Cells(j, i) <> "" Then

For k = 7 To 50

Sheets("Activite").Select

If Cells(k, i) <> "" Then

Sheets("Taches").Select

Range("A1").Select

ActiveCell.FormulaR1C1 = _

"=CONCATENATE(Activite!R[" & k - 1 & "]C,"" - "",Activite!R[" & k - 1 & "]C[1],"" - "",Activite!R[" & k - 1 & "]C[2])"

Selection.Cut

n = n + 1

Range("B" & n & "").Select

ActiveSheet.Paste

Range("A1").Select

ActiveCell.FormulaR1C1 = _

"=CONCATENATE(Activite!R[" & k - 1 & "]C[" & i - 1 & "])"

Selection.Cut

Range("C" & n & "").Select

ActiveSheet.Paste

Range("A1").Select

ActiveCell.FormulaR1C1 = _

"=CONCATENATE(Zone!R[" & j - 1 & "]C[1])"

Selection.Cut

Range("E" & n & "").Select

ActiveSheet.Paste

Range("A1").Select

ActiveCell.FormulaR1C1 = _

"=CONCATENATE(Zone!R[" & j - 1 & "]C[2])"

Selection.Cut

Range("F" & n & "").Select

ActiveSheet.Paste

Range("A1").Select

ActiveCell.FormulaR1C1 = _

"=CONCATENATE(Zone!R[4]C[" & i - 1 & "])"

Selection.Cut

Range("G" & n & "").Select

ActiveSheet.Paste

Range("A1").Select

ActiveCell.FormulaR1C1 = _

"=CONCATENATE(Activite!R[" & k - 1 & "]C)"

Selection.Cut

Range("H" & n & "").Select

ActiveSheet.Paste

Range("A1").Select

ActiveCell.FormulaR1C1 = _

"=CONCATENATE(Activite!R[" & k - 1 & "]C[1])"

Selection.Cut

Range("I" & n & "").Select

ActiveSheet.Paste

Range("A" & n & "").Select

ActiveCell.FormulaR1C1 = "=" & x & ""

x = x + 1

End If

Next k

End If

Next i

End If

Next j

End Sub

Je vous remercie d'avance.

Bonne fin de journée

23exemple.xlsm (22.41 Ko)
Le 13/05/2013 à 17:10

Salut!

Un fichier exemple peut-être?

Quelle erreur est renvoyée?

Edit:

Au fait à qui sert ton "" dans ton Range("G" & n & "").Select ??

Le 13/05/2013 à 17:23

J'ai rajouté un fichier exemple.

Lorsque je lance la macro, je n'ai pas de message d'erreur, j'ai juste excel qui ne répond plus (j'ai laissé tourné pas mal de temps)

Le "Range("G" & n & "").Select" permet de sélectionner la cellule dans laquelle je désire effectuer mon collage.

Le 13/05/2013 à 18:22

Ah ca sent la boucle qui fini jamais ton truc. Je regarde ça ce soir

Le 13/05/2013 à 23:26

Je viens de regarder.

Je ne comprends pas vraiment le but du fichier mais au niveau du code déjà il y a des choses bizarres.

- A quoi celà te sert de couper et coller systématiquement tes formules de la cellule A1 à la cellule de destination? Ne vaut-il pas mieux directement inscrire la formule dans la cellule finale?

- Concernant tes formules. Je pense qu'il serait préférable d'oublier les concatenate qui ne sont pas utiles quand tu n'as qu'une seule valeur.

Ensuite la macro marche en réalité c'est juste qu'elle met un temps infini à s'executer J'ai testé, elle rapporte environ 6000 lignes dans le tableau cible. Est-ce ce qui est prévu? Sinon il faut envisager de savoir pourquoi autant de lignes sont générées.

Si c'est bon, le but est d'accélérer au maximum l'execution. Donc virer les copier/coller inutiles, simplifier les formules et ... attendre...

Ci joint un code indicatif un peu simplifié mais bon ça fait tout de même 1min30 d'execution sur mon pc core i5. -ça reste mieux que 30 minutes)

Public i As Integer
Public j As Integer
Public k As Integer
Public n As Integer
Public x As Integer

Sub macrowbs()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

p = 5
n = 1
x = 1
j = 7

Sheets("Taches").Select
Range("A2:J6000").Select
Selection.ClearContents
Sheets("Zone").Select

Do
If Not IsEmpty(Cells(j, 2)) Then
i = 4

Do
If Not IsEmpty(Cells(j, i)) Then
k = 7

Do
Sheets("Activite").Select
If Not IsEmpty(Cells(k, i)) Then
Sheets("Taches").Select

n = n + 1
Range("B" & n).Value = Sheets("Activite").Cells(k, 1).Value & " - " & Sheets("Activite").Cells(k, 2).Value & " - " & Sheets("Activite").Cells(k, 3).Value
Range("C" & n).Value = Sheets("Activite").Cells(k, i).Value
Range("E" & n).Value = Sheets("Zone").Cells(j, 2).Value
Range("F" & n).Value = Sheets("Zone").Cells(j, 3).Value
Range("F" & n).Value = Sheets("Zone").Cells(5, i).Value
Range("H" & n).Value = Sheets("Activite").Cells(k, 1).Value
Range("I" & n).Value = Sheets("Activite").Cells(k, 2).Value
Range("A" & n).Value = x
x = x + 1

End If
k = k + 1
Loop Until k = 51

End If
i = i + 1
Loop Until i = 31

End If
j = j + 1
Loop Until j = 21

MsgBox ("Operation terminée")

End Sub
Le 14/05/2013 à 09:35

6000 lignes n'est pas vraiment le résultat attendu. Il faudrait obtenir 414 lignes.

De plus je suis un débutant en VBA et j'ai copié coller fait des copier/coller à cause de formulaR1C1 que j'ai du mal a utilisé.

En fait, il y a encore un problème de boucle, mais ton code simplifie grandement la macro.

Elle fonctionne parfaitement avec le code suivant:

Public i As Integer
Public j As Integer
Public k As Integer
Public n As Integer
Public x As Integer

Sub macrowbs()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

n = 1
x = 1

Sheets("Taches").Select
Range("A2:J1000").Select
Selection.ClearContents
Sheets("Zone").Select

For j = 7 To 20
Sheets("Zone").Select
If Cells(j, 2) <> "" Then

    For i = 4 To 30
    Sheets("Zone").Select
    If Cells(j, i) <> "" Then

        Sheets("Activite").Select
        For k = 7 To 50
        Sheets("Activite").Select
        If Cells(k, i) <> "" Then
        Sheets("Taches").Select

n = n + 1
Range("B" & n).Value = Sheets("Activite").Cells(k, 1).Value & " - " & Sheets("Activite").Cells(k, 2).Value & " - " & Sheets("Activite").Cells(k, 3).Value
Range("C" & n).Value = Sheets("Activite").Cells(k, i).Value
Range("E" & n).Value = Sheets("Zone").Cells(j, 2).Value
Range("F" & n).Value = Sheets("Zone").Cells(j, 3).Value
Range("G" & n).Value = Sheets("Zone").Cells(5, i).Value
Range("H" & n).Value = Sheets("Activite").Cells(k, 1).Value
Range("I" & n).Value = Sheets("Activite").Cells(k, 2).Value
Range("A" & n).Value = x
x = x + 1

        End If
        Next k

    End If
    Next i

End If
Next j

MsgBox "Opération terminée"

End Sub

Merci pour ton aide

Le 14/05/2013 à 09:41

Ah en effet avec ce nouveau code on passe à moins de 10 secondes

Ravi d'avoir pu t'aider

Rechercher des sujets similaires à "erreur execution paste plantage"