Discussion :

[fastmike]

Bonjour à tous, et tout d'abord tous mes voeux pour 2013!

Deux petites questions qui peuvent être stupides ce dont je m'excuse mais je débute en VBA:

QUESTION 1. J'ai un fichier Excel disons avec une colonne B de dates (plusieurs dates peuvent etre identiques), une colonne C de chiffres (rendements).

Il me faudrait creer un autre worksheet ayant la forme suivante (une ligne par date, unique cette fois):

en colonne A: Date
en colonne B: plus petite valeur de C pour cette date
en colonne C: moyenne des rendements pour cette date

QUESTION 2. j'avais des fichiers excel de 700 à 900.000 lignes à traiter dans lesquels il faut juste enlever les lignes qui contiennent un "#N/A". J’avais commencé avec des Offset et autre Delete mais cela prenait des heures. Ensuite j'ai essayé d’optimiser le code et cela prends une vingtaine de minutes pour cette macro, mais je suis sur que l'on peut faire bien mieux. Avez-vous des suggestions?

Voice le code actuel:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
Public Sub H_DeleteNA()
 
'To delete all 'bad' cells as #N/A we got in column C and D
 
Dim fSourceH As Worksheet
Dim fDestH As Worksheet
Dim i As Long
Dim idest As Long
Dim ifin As Long
 
Set fSourceH = Worksheets("Feuil2") ' définit la feuille 1 en feuille source
Set fDestH = Worksheets("Feuil1")
idest = 1
 
 
Rows("1:1").Delete shift:=xlUp  'efface la premiere ligne qui est inutile
ifin = fSourceH.Range("C:C").End(xlDown).Row
 
For i = 1 To ifin
 
   If IsNumeric(fSourceH.Range("C" & i).Value) Then
 
        fSourceH.Range("A" & i & ":D" & i).Copy fDestH.Range("A" & idest)
        idest = idest + 1
 End If
 Next i
 
 fSourceH.Range("A:D").ClearContents 'efface Feuil2
 
Set fSourceH = Worksheets("Feuil1") ' définit la feuille 1 devient ma source
Set fDestH = Worksheets("Feuil2")
fSourceH.Activate
 
 
idest = 1
Range("A3").Activate
ifin = fSourceH.Range("d1048576").End(xlUp).Row + 1
For i = 1 To ifin
 
   If IsNumeric(fSourceH.Range("D" & i).Value) Then
 
        fSourceH.Range("A" & i & ":D" & i).Copy fDestH.Range("A" & idest)
        idest = idest + 1
 End If
 Next i
 
 fSourceH.Range("A:D").ClearContents 'efface Feuil1
 fSourceH.Name = "FeuilTemp"
 fDestH.Name = "Feul1"
End Sub

Merci par avance de vos précieux conseils

[GerardCalc]

Bonsoir,

Question 1 : Utilises le tableau croisé dynamique.
Question 2 : Le VBA est hors de mon champ de compétence.

A+

[fastmike]

Merci de ta réponse! Malheureusement je dois le coder en VBA et de toute facon les pivot table deviennent trop lent sur les gros fichiers.

Merci encore

[Philippe Tulliez]

Bonjour,
Pour la deuxième question, voici une solution.
Il y a sans doute mieux mais je n'ai pas eu le temps d'approfondir la question.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub DelRowsError()
 Dim sht As Worksheet
 Dim Rng As Range, myTable() As String, r As Long, lastRow As Long
 Set sht = ActiveSheet
 Set Rng = sht.Range("A1").CurrentRegion
 With Rng
  Set Rng = .SpecialCells(xlCellTypeFormulas, xlErrors)
 End With
 myTable = Split(Rng.Address, ",")
 With sht
  For r = UBound(myTable) To 0 Step -1
   If lastRow <> .Range(myTable(r)).Row Then
    lastRow = .Range(myTable(r)).Row: Rows(lastRow).Delete
   End If
  Next
  End With
 Set Rng = Nothing
End Sub

[EDIT]
Le code que j'ai donné est pour des messages d'erreurs sur des cellules se trouvant dans des colonnes différentes mais il peut-être plus simple si la recherche se fait sur une colonne particulière

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Sub test()
  On Error Resume Next
  Columns("H").SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete
  On Error GoTo 0
End Sub

[fastmike]

Bonsoir Philippe

Trop fort! Ceci devrait sans doute résoudre ma deuxième question. Je vais tester dès maintenant.

J'aimerai atteindre un jour cette rapidité à encoder!!!

Merci mille fois

Je viens de tester cela et je retombe un peu sur ma problématique initiale qui m'avait conduit à copier les lignes à conserver vers un autre worksheet.

En effet, si j'utilise les .Delete de Excel, cela semble bien fonctionner pour les fichiers de moins de 50 000 lignes, et ensuite cela devient d'une lenteur effroyable. En copiant les données à conserver vers une autre feuille au lieu d'effacer les lignes dans la feuille en cours, j'ai gagné énormément de temps (de plus de 6h à moins de 20 minutes pour un fichier de 900 000 lignes).

Curieusement, il semble que les fonctions delete (ou insertion) sur la feuille en cours, gèrent assez mal la mémoire, mais je n'y connais pas grand chose je l'avoue. Je continue donc de creuser.

Merci encore pour vos idées et de me permettre de bénéficier de votre connaissance.

[Philippe Tulliez]

Bonjour,
J'avoue ne pas avoir poussé le test jusqu'à ce nombre de lignes imposant.
Il y a sans doute d'autres moyens d'accélérer la vitesse.
Stopper la mise à jour de l'écran et couper le calcul automatique puisque j'ai cru comprendre qu'il y a des formules dans cette feuille.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Application.screenUpdating = False
Application.Calculation = xlCalculationManual

et en fin de procédure remettre le calcul automatique et le ScreenUpdating à True (Pas obligatoire pour ce dernier mais préférable.

[NVCfrm]

Bonsoir.
Une piste:

j'ai cru comprendre que tu cherches à purifier une plage excluant les lignes où la colonne c contiendrait une valeur d'erreur.
J'ai noté que la première ligne est inutile.
Je proposes de copier la feuille

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
dim Cible as range,rx as range
Sheets("Probleme").Copy Sheets.Count
Sheets("Probleme").UsedRange.Clear

Créer la valeur d'erreur dans la première ligne de la colonne 3

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Set rx = Sheets(Sheets.count).Range("C1")
rx.Formula="=MATCH(""wwy"",RC[1]:RC[3],0)"

Demander à Excel un objet range qui exclue toutes les cellules qui contiennent cette valeur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set cible = Sheets(Sheets.count).Range("a1").CurrentRegion.Columns(3).ColumnDifferences(rx)

il te faut 5 variables numérique de type Long

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
Dim Area_Compte as long, Area_Lignes as Long, Dest_Ligne as Long, n 
as long, i as Long
 
Do
      n=n+1
 
Loop Until n = areas_Compte

Tout se déroule dans une seule boucle. Les propriétés range nous éviteront un codage fastidieux de boucles.

Cette boucle ci-dessus balaie les Areas renvoyés par cible.
l'idée serait de faire une déduction dans cette boucle pour renvoyer la plage correspondante aux coordonnée de l'areas(n) sans passer par un balayage ligne par ligne.
Il faut savoir bien poser tes crans pour la destination:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Dest_Ligne = Sheets("Probleme").Range("a1").CurrentRegion.Rows.count

te renverra toujours la dernière ligne de données à incrémenter d'un pas.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Area_Lignes = Cible.Areas(n).Rows.Count

tu obtiens le nombre de lignes de l'areas en cours.
Area_Lignes et Dest_Ligne te suffisent pour déterminer la nouvelle plage de destination.

pour t'orienter un peu plus

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("Probleme").Range(cells(dest_ligne + 1,1),cells(dest_ligne + area_lignes+1,nombre_colonnes)).value=cible.areas(n).value

N'oublie pas qu'avant d'entrer dans la boucle, il te faut activer la feuille Problème

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

sheets("probleme").activate

n'oublie pas qu'il est essentiel de désactiver le rafraîchissement d'écran et éventuellement mettre le mode de calcul à manuel en début de procédure,
en fin de procédure, remettre le rafraîchissement d'écran en place après avoir supprimé la copie crée.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets(Sheets.count).Delete

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.ScreenUpdating=True

je penses t'avoir fourni suffisamment d'indications pour aborder ton problème.

Bon code!

Les explications ci-haut sont incomplètes.

En fait il s'agit d'obtenir la plage purifiée et non la colonne.

Il faut référencer directement la plage avec le nom de colonne n°1 et le nom de colonne en dernier:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Sheets("Probleme").Range.....Value = Sheets(Sheets.count).Range("A" & Cible.Areas(n).Row & ":C" &  Cible.Areas(n).Row + Area_Lignes).Value

Autre chose:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.InterActive=False

Vu la longueur du temps, interdire les manipulations Clavier/Souris durant l'opération éviterait l'inattendu.
Ne pas oublier de le remettre à True à la fin.