Macro interminable
AudreyAQFQ
Messages postés
1
Date d'inscription
Statut
Membre
Dernière intervention
-
eriiic Messages postés 24603 Date d'inscription Statut Contributeur Dernière intervention -
eriiic Messages postés 24603 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,
Lorsque j'exécute une macro dans mon classeur, celle-ci met plus de 5h à s'effectuer, ce qui rend impossible l'utilisation d'excel pendant ce temps.
Auriez-vous une solution pour qu'elle soit beaucoup moins longue ?
Voici le code:
Sub EclaterAllComponentsenligne()
Dim C As Range, Tabl, Plage As Range, Ligne As Long
With Sheets("Worklogs")
Set Plage = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp))
End With
With Sheets("My data")
For Each C In Plage
Tabl = Split(C.Offset(, 11), ";")
.[A:C].NumberFormat = "@"
If UBound(Tabl) = -1 Then
Ligne = Ligne + 1
.Range(.Cells(Ligne, 1), .Cells(Ligne, 11)).Value = C.Resize(, 11).Value
.Cells(Ligne, 12) = ""
.Range(.Cells(Ligne, 13), .Cells(Ligne, 42)).Value = C.Offset(0, 12).Resize(, 30).Value
Else
For i = 0 To UBound(Tabl)
Ligne = Ligne + 1
.Range(.Cells(Ligne, 1), .Cells(Ligne, 11)).Value = C.Resize(, 11).Value
.Cells(Ligne, 12) = Tabl(i)
.Range(.Cells(Ligne, 13), .Cells(Ligne, 42)).Value = C.Offset(0, 12).Resize(, 30).Value
Next i
End If
Next C
.[H:H].EntireColumn.AutoFit
End With
'
End Sub
Lorsque j'exécute une macro dans mon classeur, celle-ci met plus de 5h à s'effectuer, ce qui rend impossible l'utilisation d'excel pendant ce temps.
Auriez-vous une solution pour qu'elle soit beaucoup moins longue ?
Voici le code:
Sub EclaterAllComponentsenligne()
Dim C As Range, Tabl, Plage As Range, Ligne As Long
With Sheets("Worklogs")
Set Plage = .Range(.[A1], .Cells(.Rows.Count, 1).End(xlUp))
End With
With Sheets("My data")
For Each C In Plage
Tabl = Split(C.Offset(, 11), ";")
.[A:C].NumberFormat = "@"
If UBound(Tabl) = -1 Then
Ligne = Ligne + 1
.Range(.Cells(Ligne, 1), .Cells(Ligne, 11)).Value = C.Resize(, 11).Value
.Cells(Ligne, 12) = ""
.Range(.Cells(Ligne, 13), .Cells(Ligne, 42)).Value = C.Offset(0, 12).Resize(, 30).Value
Else
For i = 0 To UBound(Tabl)
Ligne = Ligne + 1
.Range(.Cells(Ligne, 1), .Cells(Ligne, 11)).Value = C.Resize(, 11).Value
.Cells(Ligne, 12) = Tabl(i)
.Range(.Cells(Ligne, 13), .Cells(Ligne, 42)).Value = C.Offset(0, 12).Resize(, 30).Value
Next i
End If
Next C
.[H:H].EntireColumn.AutoFit
End With
'
End Sub
A voir également:
- Macro interminable
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Jitbit macro recorder - Télécharger - Confidentialité
- Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Macro maker - Télécharger - Divers Utilitaires
- Macro word - Guide
