XL 2013 Boucle de X à X

a_loic · 1 Juin 2017

Bonjour à tous,

Je suis à la recherche d’une aide pour une macro que j’ai commencé grâce à des recherches internet.

Il me reste une erreur que je n’arrive pas à corriger.

Concrètement j’ai en colonne A toutes les X lignes (c’est aléatoire en fonction du nombre de données) le terme « identifiant ».

Ma macro trouve ce terme et récupère en dessous les données dont j’ai besoin.
Le défaut c’est que actuellement ca cherche seulement dans les 4 lignes dessous, puis ca reprend au « identifiant » suivant etc…

Je cherche donc à enlever cette condition de 4 lignes et à mettre de identifiant à identifiant…

J’espère que je suis clair. :s

Je vous colle ci-dessous la partie du code qui fait défaut :

Code:

        Sheets("Sheet1").Activate
        nbl = Range("D" & Rows.Count).End(xlUp).Row 'n° dernière ligne non vide
        dbl = 18 'n° ligne pour débuter la boucle
        Jour = Format(Range("O12").Value, "dd/mm/yyyy")
        
        For i = dbl To nbl
        
            If Range("A" & i) = "Identifiant" Then
            
                dbl = Range("A" & i).Row 'réinitialise le n° de ligne pour débuter le traitement à celle où se trouve l'identifiant recherché
                Range("D" & i).Offset(1, 0).Select
                l1 = ActiveCell.Row 'n° ligne pour débuter la sous-boucle (recherche de 50000088 et 30000089)
                
                    For j = l1 To l1 + 4 'recherche les n° GV sur les 4 lignes en dessous de l'identifiant

                        Range("D" & j).Select
                        
                        If Range("D" & j) = 50000088 Or ActiveCell = 30000089 Then
                            
                            Identifiant = Range("K" & i)
                            GV = Range("D" & j)
                            quantite = Range("AB" & j)

Un grand merci par avance,

Bonne journée,

Loic

job75 · 1 Juin 2017

Bonjour a_loic,

En VBA les Select et autres Activate sont en général inutiles, voire nuisibles.

Et s'il y a beaucoup de données, les traiter avec un tableau VBA est beaucoup plus rapide :

Code:

Dim F As Worksheet, tablo, i&, lig&, Identifiant, GV, quantite
Set F = Sheets("Sheet1")
tablo = F.Range("A1", F.UsedRange).Resize(, 28) 'colonnes A à AB
For i = 18 To UBound(tablo)
  If tablo(i, 1) = "Identifiant" Then lig = i 'mémorise la ligne
  If lig And (tablo(i, 4) = 50000088 Or tablo(i, 4) = 30000089) Then
    Identifiant = tablo(lig, 11)
    GV = tablo(i, 4)
    quantite = tablo(i, 28)
    '---suite du code---
  End If
Next

A+

camarchepas · 1 Juin 2017

Bonjour ,

Sans fichier toujours difficile de valider la solution , mais selon moi, il faut juste avoir une colonne toujours pleine lorsqu'une ligne est valide ( supposont la colonne B

dim LigneFin as long , LigneFin2 as long
LigneFin = Range("B" & rows.count).end(xlup).row ' Ligne de fin du fichier

l1 = ActiveCell.Row 'n° ligne pour débuter la sous-boucle (recherche de 50000088 et 30000089)
LigneFin2 = range("A" &activecell.row).end(xldown).row 'Ligne avec nouvel identifiant

For j = l1 To LigneFin2-1 'recherche les n° GV sur les 4 lignes en dessous de l'identifiant

Bonjour Job , en effet beaucoup plus efficace

job75 · 1 Juin 2017

Bonjour camarchepas

camarchepas à dit:
en effet beaucoup plus efficace

Oui sauf qu'il y avait une coquille que je viens de corriger.

A+

a_loic · 1 Juin 2017

Rebonjour

Merci pour vos réponses !

J'ai modifié tel que je m'imagine qu'il faut faire mais le problème c'est que maintenant mes données remontent en double...

Voici le code complet si vous y voyez l'erreur, moi jene comprends pas

Code:

 Option Compare Text

Sub ImportRecap()
    Dim objOuvrir As FileDialog
    Dim objFichiers As FileDialogSelectedItems
    Dim x As Long, nblgn As Long
    Dim Wb As Workbook
    Dim LigneFin As Long, LigneFin2 As Long
 
    'Affiche la fenêtre "Ouvrir"
    With Application.FileDialog(msoFileDialogOpen)
        .InitialFileName = ""
        'Efface les filtres existants.
        .Filters.Clear
        'Définit une liste de filtres pour le champ "Type de fichiers".
        .Filters.Add "Classeurs Excel", "*.xls; *.xlsx; *.xlsm"
        'Indique le type d'affichage dans la boîte de dialogue
        .InitialView = msoFileDialogViewDetails
        .Show
    End With
 
    'Définit le ou les fichiers à ouvrir
    Set objFichiers = Application.FileDialog(msoFileDialogOpen).SelectedItems
 
    'On sort si aucun fichier n'a été sélectionné
    If objFichiers.Count = 0 Then Exit Sub
 
 
    Application.ScreenUpdating = False
 
    'Boucle sur le ou les fichiers Excel sélectionnés pour les ouvrir
    For x = 1 To objFichiers.Count
        Set Wb = Workbooks.Open(objFichiers(x))
        '
        'TRAITEMENT
        '
        Sheets("Sheet1").Activate
        nbl = Range("D" & Rows.Count).End(xlUp).Row 'n° dernière ligne non vide
        dbl = 18 'n° ligne pour débuter la boucle
        LigneFin = Range("B" & Rows.Count).End(xlUp).Row ' Ligne de fin du fichier
        l1 = ActiveCell.Row 'n° ligne pour débuter la sous-boucle (recherche de 50000088 et 30000089)
        LigneFin2 = Range("A" & ActiveCell.Row).End(xlDown).Row 'Ligne avec nouvel identifiant

 
        Jour = Format(Range("O12").Value, "dd/mm/yyyy")
        
        For i = dbl To nbl
        
            If Range("A" & i) = "Identifiant" Then
            
                dbl = Range("A" & i).Row 'réinitialise le n° de ligne pour débuter le traitement à celle où se trouve l'identifiant recherché
                Range("D" & i).Offset(1, 0).Select
                l1 = ActiveCell.Row 'n° ligne pour débuter la sous-boucle (recherche de 50000088 et 30000089)
                
                    For j = l1 To LigneFin2 - 1 'recherche les n° GV sur les 4 lignes en dessous de l'identifiant

                        Range("D" & j).Select
                        
                        If Range("D" & j) = 50000088 Or ActiveCell = 30000089 Then
                            
                            Identifiant = Range("K" & i)
                            GV = Range("D" & j)
                            quantite = Range("AB" & j)
                            
                            ThisWorkbook.Activate
                            With ThisWorkbook.Sheets("BDD_GV")
                                dl = Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
                                Cells(dl, 1) = Jour 'si date = date du jour de l'import Récap
                                Cells(dl, 2) = Identifiant
                                Cells(dl, 3) = GV
                                Cells(dl, 4) = quantite
                            End With
                            
                            Wb.Activate
                            
                        End If
                        
                    Next j
            End If

        Next i
        '
        '
        '
        'Referme le classeur sans enregistrer les modifications.
        Wb.Close False
    Next
 
    Application.ScreenUpdating = True
 
End Sub

camarchepas · 1 Juin 2017

Loic,

Sans un fichier pour tester, pour ma part , je n'irai pas plus loin.

Bon courage

a_loic · 1 Juin 2017

Re

Je te joins le document avec la macro nommé "TEST_EX.SUIVI.GV" et un exemple de recap que ma macro va chercher ("EX.RECAP.GV").

Redis moi si besoin,

Merci pour ton aide,

Bonne journée,

Loic

a_loic · 1 Juin 2017

Re

Pour être franc, je suis passé à côté de ta proposition.

Je viens donc de la tester et pour le coup je n'arrive pas à l'adapter.

Voilà ce que j'ai fait et j'au un débogage à tous les coup

Code:

Option Compare Text

Sub ImportRecap()
  Dim objOuvrir As FileDialog
  Dim objFichiers As FileDialogSelectedItems
  Dim x As Long, nblgn As Long
  Dim Wb As Workbook
  Dim F As Worksheet, tablo, i&, lig&, Identifiant, GV, quantite
 
  'Affiche la fenêtre "Ouvrir"
  With Application.FileDialog(msoFileDialogOpen)
  .InitialFileName = ""
  'Efface les filtres existants.
  .Filters.Clear
  'Définit une liste de filtres pour le champ "Type de fichiers".
  .Filters.Add "Classeurs Excel", "*.xls; *.xlsx; *.xlsm"
  'Indique le type d'affichage dans la boîte de dialogue
  .InitialView = msoFileDialogViewDetails
  .Show
  End With
 
  'Définit le ou les fichiers à ouvrir
  Set objFichiers = Application.FileDialog(msoFileDialogOpen).SelectedItems
 
  'On sort si aucun fichier n'a été sélectionné
  If objFichiers.Count = 0 Then Exit Sub
 
 
  Application.ScreenUpdating = False
 
  'Boucle sur le ou les fichiers Excel sélectionnés pour les ouvrir
  For x = 1 To objFichiers.Count
  Set Wb = Workbooks.Open(objFichiers(x))
  '
  'TRAITEMENT
  '
  
  Set F = Sheets("Sheet1")
 tablo = F.Range("A1", F.UsedRange).Resize(, 28) 'colonnes A à AB
 Jour = Format(Range("O12").Value, "dd/mm/yyyy")
 For i = 18 To UBound(tablo)
  If tablo(i, 1) = "Identifiant" Then lig = i 'mémorise la ligne
  If lig And (tablo(i, 4) = 50000088 Or tablo(i, 4) = 30000089) Then
  Identifiant = tablo(lig, 11)
  GV = tablo(i, 4)
  quantite = tablo(i, 28)
  
  
  Identifiant = Range("K" & i)
  GV = Range("D" & j)
  quantite = Range("AB" & j)
  
  ThisWorkbook.Activate
  With ThisWorkbook.Sheets("BDD_GV")
  dl = Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row
  Cells(dl, 1) = Jour 'si date = date du jour de l'import Récap
  Cells(dl, 2) = Identifiant
  Cells(dl, 3) = GV
  Cells(dl, 4) = quantite
  End With
  
  Wb.Activate
  End If
 Next

  '
  '
  'Referme le classeur sans enregistrer les modifications.
  Wb.Close False
  Next
 
  Application.ScreenUpdating = True

Encore merci pour l'aide,

Bonne journée,

Loic

job75 · 1 Juin 2017

Re,

Après un sérieux nettoyage de votre code :

Code:

Option Explicit
Option Compare Text

Sub ImportRecap()
  Dim objOuvrir As FileDialog
  Dim objFichiers As FileDialogSelectedItems
  Dim x As Long
  Dim F1 As Worksheet, dl&, Wb As Workbook
  Dim F2 As Worksheet, tablo, jour, i&, lig&
  'Affiche la fenêtre "Ouvrir"
  With Application.FileDialog(msoFileDialogOpen)
  .InitialFileName = ""
  'Efface les filtres existants.
  .Filters.Clear
  'Définit une liste de filtres pour le champ "Type de fichiers".
  .Filters.Add "Classeurs Excel", "*.xls; *.xlsx; *.xlsm"
  'Indique le type d'affichage dans la boîte de dialogue
  .InitialView = msoFileDialogViewDetails
  .Show
  End With
  'Définit le ou les fichiers à ouvrir
  Set objFichiers = Application.FileDialog(msoFileDialogOpen).SelectedItems
  'On sort si aucun fichier n'a été sélectionné
  If objFichiers.Count = 0 Then Exit Sub
  Application.ScreenUpdating = False
  Set F1 = Sheets("BDD_GV")
  dl = 7 'ligne de titres
 
  'Boucle sur le ou les fichiers Excel sélectionnés pour les ouvrir
  For x = 1 To objFichiers.Count
  Set Wb = Workbooks.Open(objFichiers(x))
  '
  'TRAITEMENT
  '
  Set F2 = Wb.Sheets("Sheet1")
  tablo = F2.Range("A1", F2.UsedRange).Resize(, 28) 'colonnes A à AB
  jour = F2.Range("O12")
  For i = 18 To UBound(tablo)
    If tablo(i, 1) Like "Identifiant*" Then lig = i 'mémorise la ligne
    If lig And (CStr(tablo(i, 4)) = "50000088" Or CStr(tablo(i, 4)) = "30000089") Then
      dl = dl + 1
      F1.Cells(dl, 1) = jour 'si date = date du jour de l'import Récap
      F1.Cells(dl, 2) = tablo(lig, 11) 'Identifiant
      F1.Cells(dl, 3) = tablo(i, 4) 'GV
      F1.Cells(dl, 4) = tablo(i, 28) 'Quantité
    End If
  Next i
  '
  '
  'Referme le classeur sans enregistrer les modifications.
  Wb.Close False
  Next x
 
  F1.Rows(dl + 1 & ":" & F1.Rows.Count).Delete 'RAZ en dessous
  Application.ScreenUpdating = True
End Sub

Remarques :

- il vaut mieux utiliser Like "Identifiant*" si l'on veut que "Identifiant collabo" soit traité

- vos 50000088 et 30000089 sont parfois des nombres, parfois des textes... d'où les CStr.

A+

a_loic · 2 Juin 2017

Bonjour,

Merci pour le code et le nettoyage

Seul soucis c'est que désormais les données ne se cumullent pas mais se remplacent

De plus, la ligne "total" en bas du document de recap est prise en compte alors que seules les régions doivent l'être.

Enfin, puis-je ajouter un :

Code:

  'Gestion si erreur d'exécution
   On Error GoTo gestionErreur

    'corps de la procédure
   '[...]
   
gestionErreur:
'affiche un message d'erreur
   MsgBox "Une erreur est survenue et l'import des données n'a pas pu être effectué."

pour empêcher que si on sélectionne un mauvais document, la macro bug?
Où dois je l'insérer car ca ne change rien quand j'essaie

Encore un grand merci,

Bonne journée,
Loic

job75 · 2 Juin 2017

Bonjour a_loic, le forum,

a_loic à dit:
Seul soucis c'est que désormais les données ne se cumullent pas mais se remplacent

C'est quand même évident, remplacez dl = 7 'ligne de titres par :

Code:

dl = Range("A" & Rows.Count).End(xlUp).Row

Bonne journée.

job75 · 2 Juin 2017

Re,

a_loic à dit:
pour empêcher que si on sélectionne un mauvais document, la macro bug?

Faut pas avoir peur des bugs cher ami, c'est instructif... et il y a toujours un message...

Après avoir essuyé un bug on peut espérer que l'utilisateur ne recommencera pas !

A+

job75 · 2 Juin 2017

Re,

Pour ce qui est de l'histoire du TOTAL remettre lig à zéro quand il est rencontré en colonne B :

Code:

    If tablo(i, 1) Like "Identifiant*" Then lig = i 'mémorise la ligne
    If tablo(i, 2) Like "TOTAL*" Then lig = 0 'RAZ
    If lig And (CStr(tablo(i, 4)) = "50000088" Or CStr(tablo(i, 4)) = "30000089") Then

A+

a_loic · 2 Juin 2017

Re

Merci beaucoup pour l'aide, tout semble parfait maintenant.

Excellente journée,

Loic

XL 2013 Boucle de X à X

a_loic

XLDnaute Junior

job75

XLDnaute Barbatruc

camarchepas

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

a_loic

XLDnaute Junior

camarchepas

XLDnaute Barbatruc

a_loic

XLDnaute Junior

Pièces jointes

a_loic

XLDnaute Junior

job75

XLDnaute Barbatruc

a_loic

XLDnaute Junior

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

job75

XLDnaute Barbatruc

a_loic

XLDnaute Junior

Discussions similaires