Aide à l'ecriture d'une macro

[Malka]

Bonjour à tous,

J'ai besoin de votre aide pour ecrire un code vba...
C'est en fait une boucle qui doit travailler sur 700000 lignes (excel 2007)
J'ai essayé de faire le travail à la main avec un jeu de filtre mais mon ordi plante tout le temps car il y a trop de lignes.... d'ou la solution via une macro

Mon tableau est structuré de la maniere suivante :
Colonne B : les années allant de 2009 à 2011
Colonne D : no de compte commencant par 6 ,7 ,96 ou 97
Colonne I : Texte 1
Colonne K : Texte 2
Colonne L : resultat de la macro

La macro doit faire pour chacune de cellule de la colonne D (D2 : D743477) :

Pour B egale à 2009 ou 2010
Si la cellule D commence par 6 ou 96 et si K egale à "Batiments" ou "Terrains" alors renvoie donnée de la colonne I dans L pour le reste des cellules commencant par 6 ou 96 renvoie les données de K dans L

Si la cellule D commence par 7 ou 97 alors renvoie données de colonne K dans L

Pour B egale à 2011 :
renvoie les données de I vers L

J'espere que c'a été clair.....

Merci

Malka

 

[néné06]

Re : Aide à l'ecriture d'une macro

bonsoir malka
Une pièce jointe avec ce que tu as et ce que tu veux nous serait d'une grande utilité.

à te relire

A+

 

[GeoTrouvePas]

Re : Aide à l'ecriture d'une macro

Bonsoir,

Quelques chose comme ça devrait aller non ? :

Sub test()

For i = 1 To 70000
    If Cells(i, 2) = 2009 Or Cells(i, 2) = 2010 Then
        If (Left(Cells(i, 4), 1) = 6 Or Left(Cells(i, 4), 2) = 96) And (Cells(i, 11) = "Batiments" Or Cells(i, 11) = "Terrains") Then
                Cells(i, 12) = Cells(i, 9)
        Else
                Cells(i, 12) = Cells(i, 11)
        End If
    Else
        Cells(i, 12) = Cells(i, 9)
    End If
Next

End Sub

 

[KenDev]

Re : Aide à l'ecriture d'une macro

Bonjour Malka, le fil

Sauf bétise ceci devrait faire l'affaire (je suppose qu'il s'agit d'une opération unique de reformatage de "base" ? A coller dans un module standard et à lancer depuis la feuile concernée. Faire une copie de sauvegarde avant. Testée sur 1000 lignes.

Important : j'ai supposé que la dernière case de la colonne B était non vide. Si ce n'est pas le cas adapter cette ligne :

nRow = Cells(Rows.Count, 2).End(xlUp).Row

en remplacant le 2 par le numéro d'une colonne dont la dernière case est non nulle.

Sub test()
Dim nRow As Long, i As Long
Dim YearB As Integer
Dim CompD As String

  
    nRow = Cells(Rows.Count, 2).End(xlUp).Row
    
    For i = 2 To nRow
        YearB = Cells(i, 2)
        Select Case YearB
            Case 2009, 2010
                Select Case Left(Cells(i, 4), 1)
                    Case "6", "7"
                        CompD = Left(Cells(i, 4), 1)
                    Case "9"
                        CompD = Right(Left(Cells(i, 4), 2), 1)
                    Case Else
                        GoTo line1
                End Select
                Select Case CompD
                    Case "6"
                        If Cells(i, 11) = "Batiments" Or Cells(i, 11) = "Terrains" Then
                            Cells(i, 12) = Cells(i, 9)
                        Else
                            Cells(i, 12) = Cells(i, 11)
                        End If
                    Case "7"
                        Cells(i, 12) = Cells(i, 11)
                End Select
            Case 2011
                Cells(i, 12) = Cells(i, 9)
        End Select
line1:
    Next i
    
End Sub

Cordialement

KD

Edit : oups, grillé

@GeoTrouvePas : il me semble conserver un vieux souvenir ou un left (ou right ou ce genre de chose) sur un nombre m'avait provoqué une erreur inattendue. Tu fais la supposition que les numéros de comptes commencent forcément par 6, 7, 96 ou 97 ? Tu as très certainement raison mais j'ai préféré en tenir compte.

 

[Papou-net]

Re : Aide à l'ecriture d'une macro

Bonsoir à tous,

Pour reprendre la proposition de KenDev, voici une variante qui ignore les cellules vides :

Sub test()
Dim nRow As Long, i As Long
Dim YearB As Integer
Dim CompD As String

    For Each cel In Sheets("Feuil2").Range("D2:D743477").SpecialCells(xlCellTypeConstants)
        i=cel.row
        YearB = Cells(i, 2)
        Select Case YearB
            Case 2009, 2010
                Select Case Left(Cells(i, 4), 1)
                    Case "6", "7"
                        CompD = Left(Cells(i, 4), 1)
                    Case "9"
                        CompD = Right(Left(Cells(i, 4), 2), 1)
                    Case Else
                        GoTo line1
                End Select
                Select Case CompD
                    Case "6"
                        If Cells(i, 11) = "Batiments" Or Cells(i, 11) = "Terrains" Then
                            Cells(i, 12) = Cells(i, 9)
                        Else
                            Cells(i, 12) = Cells(i, 11)
                        End If
                    Case "7"
                        Cells(i, 12) = Cells(i, 11)
                End Select
            Case 2011
                Cells(i, 12) = Cells(i, 9)
        End Select
line1:
    Next
   
End Sub

Avec cette boucle, il peut y avoir des cellules vides au sein du tableau.

Espérant avoir été utile.

Cordialement.

 

[job75]

Re : Aide à l'ecriture d'une macro

Bonjour le fil, le forum,

Avec 700000 lignes, il faut utiliser des tableaux pour diminuer la durée du calcul :

Sub Remplir()
Dim plage As Range, t1, t2, t3, t4, T(), n As Long, i As Long
Set plage = Range("B2", Range("B" & Rows.Count).End(xlUp)) 'B2 à adapter
t1 = Application.Transpose(plage)
t2 = Application.Transpose(plage.Offset(, 2)) 'colonne D
t3 = Application.Transpose(plage.Offset(, 7)) 'colonne I
t4 = Application.Transpose(plage.Offset(, 9)) 'colonne K
n = UBound(t1)
ReDim T(1 To n)
For i = 1 To n
  If Val(t1(i)) Then _
    T(i) = IIf(t1(i) = 2011 Or (t2(i) Like "6*" Or t2(i) Like "96*") _
      And (t4(i) = "Batiments" Or t4(i) = "Terrains"), t3(i), t4(i))
Next
Range("L2").Resize(n) = Application.Transpose(T) 'L2 à adapter
Range(Range("L2").Offset(n), Range("L" & Rows.Count)).ClearContents
End Sub

Nota : si en colonne B on avait des dates, écrire T(i) = IIf(Year(t1(i)) = 2011...

A+

 

[Malka]

Re : Aide à l'ecriture d'une macro

Bonsoir à tous !!

Je viens tout juste de lire toutes vos reponses ! Je n'ai pas encore testé et je vous tiendrai au courant

Merci beaucoup pour vos réponses

Malka

 

[Malka]

Re : Aide à l'ecriture d'une macro

Salut,

Un petit saut dans le forum pour dire que les macros que vous m'avez données marchent du tonnerre !!
Merci à tous

Malka