Probleme de performance sur merge avec gros fichier

Bonjour,

J'ai un fichier conséquent (380 000 lignes) pour lequel je dois fusionner les lignes dont la première cellule a la même valeur.

J'ai écrit une macro que j'ai testé sur un petit fichier et qui semble fonctionner mais qui devient inutilisable sur le fichier global.

Voici le code, je suis preneuse de toute idée lumineuse qui me permettrait de processer mon fichier

Sub Merge()
Dim Col As Integer, Lg As Long, nLg As Byte, Nom As String

' on part de la ligne 2
' Nom = contenu de la colonne 1, càd nom du tweetos
Nom = Cells(2, 1)
' Lg : ligne courante
Lg = 2
' nLg : offset par rapport à la ligne courante
nLg = 1

' tant que la cellule de la colonne 1 n'est pas vide

While Nom <> ""
' tant que le contenu de la colonne1 est égal à celui de la ligne Lg
  While Cells(Lg, 1).Offset(nLg, 0) = Nom

'on additionne le contenu des cellules colonnes 2 et 3
      Cells(Lg, 2) = Cells(Lg, 2) + Cells(Lg, 2).Offset(nLg, 0)
      Cells(Lg, 3) = Cells(Lg, 3) + Cells(Lg, 3).Offset(nLg, 0)
      Rows(Lg + nLg).Delete
' passage à la ligne suivante

      Wend

  Lg = Lg + 1

  Nom = Cells(Lg, 1)

Wend

End Sub

Merci d'avance

Bonsoir et bienvenue

Merci de joindre un fichier.

Amicalement

Nad

Merci pour cette réponse rapide.

Ci-joint les premières lignes de mon méga fichier.

Les lignes de doublons en première colonne doivent être fusionnées en additionnant les colonnes 2 et 3 .

Bonsoir

A tester

Doit être possible d'aller plus vite encore (peut-être)

Option Explicit

Sub Merge()
Dim J As Long
Dim NbLg As Long

  Application.ScreenUpdating = False
  NbLg = Range("A" & Rows.Count).End(xlUp).Row
  For J = NbLg To 3 Step -1
    If Range("A" & J) = Range("A" & J - 1) Then
      Range("B" & J - 1) = Range("B" & J - 1) + Range("B" & J)
      Range("C" & J - 1) = Range("C" & J - 1) + Range("C" & J)
      Rows(J).Delete
    End If
  Next J
End Sub

Bonjour Banzai64,

Un test de votre macro sur une sous partie de 28500 lignes aboutit en 5 minutes ... là où ma macro prenait plus de deux heures !!!

C'est vraiment super.

Ultime question. Mes doublons ne respectent pas la casse (ert est un doublon de Ert) et mon code initial avait omis ce point. L'ajout du Ucase n'aura pas d'influence sur les perfos ?

Merci infiniment de votre aide et de la rapidité de votre réponse,

Emmanuelle

petit update: j'ai lancé la macro de Banzai64 sur mon gros fichier. Elle tourne depuis 2 heures maintenant. Quelqu'un à une idée d'ordre de grandeur pour le temps d'exécution ?

Merci à tous,

Emmanuelle

Bonjour

Ne disposant pas d'un fichier important

Un autre essai

Option Explicit

Sub Merge()
Dim J As Long
Dim K As Long
Dim Tablo
Dim NbLg As Long
Dim I As Integer

Dim T
T = Time

  Application.ScreenUpdating = False
  Columns("A").NumberFormat = "General"
  NbLg = Range("A" & Rows.Count).End(xlUp).Row
  Tablo = Range("A1:N" & NbLg)
  For J = UBound(Tablo) To 3 Step -1
    If Tablo(J, 1) = Tablo(J - 1, 1) Then
      Tablo(J - 1, 2) = Tablo(J - 1, 2) + Tablo(J, 2)
      Tablo(J - 1, 3) = Tablo(J - 1, 3) + Tablo(J, 3)
      Tablo(J, 1) = ""
    End If
  Next J

  K = 1
  For J = 2 To UBound(Tablo)
    If Tablo(J, 1) <> "" Then
      K = K + 1
      For I = 1 To UBound(Tablo, 2)
        Tablo(K, I) = Tablo(J, I)
      Next I
    End If
  Next J
  Cells.ClearContents
  Range("A1").Resize(K, UBound(Tablo, 2)) = Tablo

  MsgBox "Durée " & Format(Time - T, "hh:mm:ss")
End Sub

Bonjour,

La macro précédente mouline depuis presque 5 heures maintenant, vous pensez que c'est mieux de l'arréter pour teste avec la nouvelle macro ?

le fichier cible est énorme mais si vous voulez je peux vous le mettre à dispo via dropbox ... si ce n'est pas trop abuser !!

Merci pour votre aide

Bonjour

Bien sur s'il ne contient pas de données sensibles

hmmmm

Emma34 a écrit :

mouline depuis presque 5 heures

Moi j'aurais fais un stop au bout de 10 mn

[b]Attention je n'ai qu'Excel 2003 (suis limité à 65536 lignes)

Mais déjà avec un fichier de cette taille permettra de tester[/b]

je viesn de vous envoyer un message privé