IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Macro ComPleXe Excel [XL-2007]


Sujet :

Macros et VBA Excel

  1. #1
    Membre averti
    Profil pro
    Inscrit en
    Juin 2010
    Messages
    29
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juin 2010
    Messages : 29
    Par défaut Macro ComPleXe Excel
    Bonjour!

    Alors j'ai une macro très compliqué à faire je sais même pas si je vais réussir à vous l'expliquer correctement.
    Alors voila, il faut que j'inscrive dans une feuille excel(feuille 3) toutes les lignes contenus dans une autre feuille(feuille 1) où il y a à la fois dans la colonne A un chiffre commençant par 6 et dans la colonne G un chiffre supérieur à un autre chiffre indiqué dans une autre feuille(feuille 2) dans la cellule C3.

    Voilà à vous les pros d'excel...

  2. #2
    Membre Expert
    Homme Profil pro
    Ingénieur systèmes et réseaux
    Inscrit en
    Avril 2008
    Messages
    875
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Yvelines (Île de France)

    Informations professionnelles :
    Activité : Ingénieur systèmes et réseaux
    Secteur : Conseil

    Informations forums :
    Inscription : Avril 2008
    Messages : 875
    Par défaut
    tu ne veux pas essayer de rédiger le début d'un code?

  3. #3
    Membre très actif

    Profil pro
    Inscrit en
    Mai 2003
    Messages
    336
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Mai 2003
    Messages : 336
    Billets dans le blog
    1
    Par défaut
    sinon voici un code (non testé) :

    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 Programme()
     
    Set plage = thisworkbook.sheets(1).range(cells(1,1),cells(1,1).End(XlDown)
    ' >> ou bien :
    ' Set plage = thisworkbook.sheets(1).range(cells(1,1),cells(1,X)) où X est le 'numéro de la dernière ligne de la feuille 1 que tu vx analysé
     
    ligne = 1
     
    For each cellule in plage
     
    if Left(cellule.value,1) = 6 and cellule.offset(0,6).value > sheets(2).range("C3").value then
    sheets(3).rows(cellule.row).copy Destination:=cells(ligne,1)
    ligne = ligne + 1
    end if
     
    End sub

  4. #4
    Membre averti
    Profil pro
    Inscrit en
    Juin 2010
    Messages
    29
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juin 2010
    Messages : 29
    Par défaut
    Merci sympasteve parce que j'arrivais pas à trouver.

    Sinon la macro bloque

    Voilà ce que ça donne:

    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
    Sub Extraction()
     
    Set plage = thisworkbook.sheets(1).range(cells(1,1),cells(1,1).End(XlDown)
     
    ligne = 1
     
    For Each cellule In plage
     
    If Left(cellule.Value, 1) = 6 And cellule.Offset(0, 6).Value > Sheets(2).Range("C3").Value Then
    Sheets(3).Rows(cellule.Row).Copy Destination:=Cells(ligne, 1)
    ligne = ligne + 1
    End If
    Next
     
     
    End Sub

    Ca bloque au niveau du "set plage".
    J'ai essayé avec l'autre méthode ça bloque aussi.

    Je l'ai encore modifié sur quelque petit point:

    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
    Sub Extraction()
     
    Set plage = ThisWorkbook.Sheets(1).Range(Cells(1, 1), Cells(1, 500).End(xlDown)).Select
     
    ligne = 1
     
    For Each cellule In plage
     
    If Left(cellule.Value, 1) = 6 And cellule.Offset(0, 6).Value > Sheets(2).Range("C3").Value Then
    Sheets(3).Rows(cellule.Row).Copy Destination:=Cells(ligne, 1)
    ligne = ligne + 1
    End If
    Next
     
     
    '
    End Sub

  5. #5
    Expert éminent Avatar de mercatog
    Homme Profil pro
    Inscrit en
    Juillet 2008
    Messages
    9 435
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Autre

    Informations forums :
    Inscription : Juillet 2008
    Messages : 9 435
    Par défaut
    dans le même sens (en indiquant le nom de la feuille et non son index qui peut changer en fonction de l'emplacement des feuilles)
    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
    Dim i As Long, LastLig As Long, NewLig As Long
    Dim Crit As Double
     
    Application.ScreenUpdating = False
    Crit = Sheets("Feuil2").Range("C3").Value
    NewLig = Sheets("Feuil3").Cells(Rows.Count, 1).End(xlUp).Row + 1
    With Sheets("Feuil1")
        LastLig = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To LastLig
            If Left(.Range("A" & i).Value, 1) = 6 And .Range("G" & i).Value >= Crit Then
                .Rows(i).Copy Sheets("Feuil3").Range("A" & NewLig)
                NewLig = NewLig + 1
            End If
        Next i
    End With

  6. #6
    Membre averti
    Profil pro
    Inscrit en
    Juin 2010
    Messages
    29
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juin 2010
    Messages : 29
    Par défaut
    Ok c'est bon elle marche.

    Merci beaucoup!

  7. #7
    Membre averti
    Profil pro
    Inscrit en
    Juin 2010
    Messages
    29
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juin 2010
    Messages : 29
    Par défaut
    Bonjour,

    Je voudrais relancer ce sujet car mon tableau a changé.

    Alors en fait maintenant dans la colonne A, où j'ai mes cellules commençant par "7" j'ai aussi des cellules avec uniquement le chiffre "7".Celle là je ne souhaiterais pas les reprendre.

    J'ai essayé en changeant le critère 7 dans la macro par le critère "7*" mais cela ne marche pas...

    Quelqu'un aurait-il une solution?

    Merci d'avance

  8. #8
    Membre émérite
    Profil pro
    Inscrit en
    Avril 2008
    Messages
    633
    Détails du profil
    Informations personnelles :
    Âge : 57
    Localisation : France

    Informations forums :
    Inscription : Avril 2008
    Messages : 633
    Par défaut
    Bonjour

    tu peux remplacer

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    If Left(.Range("A" & i).Value, 1) = 6 And .Range("G" & i).Value >= Crit Then
    par
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    If .Range("A" & i).Value Like "7?*" = True And .Range("G" & i).Value >= Crit Then

  9. #9
    Membre averti
    Profil pro
    Inscrit en
    Juin 2010
    Messages
    29
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juin 2010
    Messages : 29
    Par défaut
    Ok merci ça marche nikél

    Mais du coup j'aperçois qu'il y a des chiffres à 2 nombres que je ne veux pas extraire...

    Comment faire pour par exemple extraire uniquement les chiffres commençant par 75 ou 73 par exemple
    Il doit y avoir une formule ou comme dans excel.

    Ou plus simple, avoir uniquement les comptes différents de du chiffre "60", différent du chiffre "61", ça allégera un peu plus la macro parce que il y a pas mal de nombre à extraire

  10. #10
    Membre émérite
    Profil pro
    Inscrit en
    Avril 2008
    Messages
    633
    Détails du profil
    Informations personnelles :
    Âge : 57
    Localisation : France

    Informations forums :
    Inscription : Avril 2008
    Messages : 633
    Par défaut
    bonjour

    pour 75 ou 73

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    If .Range("A" & i).Value like "[73,75]*" = True And .Range("G" & i).Value >= Crit Then

  11. #11
    Membre averti
    Profil pro
    Inscrit en
    Juin 2010
    Messages
    29
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juin 2010
    Messages : 29
    Par défaut
    Voila ma macro:

    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
    Sub ExtraireProduits()
    '
    ' ExtraireProduits Macro
    '
    Dim i As Long, LastLig As Long, NewLig As Long
    Dim Crit As Double
     
    Application.ScreenUpdating = False
    Crit = Sheets("Feuil2").Range("C8").Value
    NewLig = Sheets("Feuil4").Cells(Rows.Count, 1).End(xlUp).Row + 1
    With Sheets("Feuil1")
        LastLig = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To LastLig
           If .Range("A" & i).Value Like "[73,75]*" = True And .Range("K" & i).Value >= Crit Then
                .Rows(i).Copy Sheets("Feuil4").Range("A" & NewLig)
                NewLig = NewLig + 1
            End If
        Next i
    End With
    '
    End Sub
    L'extraction prend toutes les lignes et non seulement ceux commençant par 73 et 75

  12. #12
    Membre émérite
    Profil pro
    Inscrit en
    Avril 2008
    Messages
    633
    Détails du profil
    Informations personnelles :
    Âge : 57
    Localisation : France

    Informations forums :
    Inscription : Avril 2008
    Messages : 633
    Par défaut
    bonjour

    La seul solution que j'ai trouvé ce fait en deux étapes (précisions en commentaire)

    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
     
    Sub ExtraireProduits()
    '
    ' ExtraireProduits Macro
    '
    Dim i As Long, LastLig As Long, NewLig As Long
    Dim Crit As Double
     
    Application.ScreenUpdating = False
    Crit = Sheets("Feuil2").Range("C8").Value
    NewLig = Sheets("Feuil4").Cells(Rows.Count, 1).End(xlUp).Row + 1
    With Sheets("Feuil1")
        LastLig = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To LastLig
           '1er étape vérifier qu'il y ai au moins 2 caractères
           'dont le premier commençant par 7 avec like
           If .Range("A" & i).Value Like "7?*" = True And .Range("K" & i).Value >= Crit Then
              '2eme étape vérifier que les deux premier chiffres sont présent
              'dans la chaine "75 73" avec instr
              If InStr(1, "75 73", .Left(Range("A" & i).Value), 2) > 0 Then
                .Rows(i).Copy Sheets("Feuil4").Range("A" & NewLig)
                NewLig = NewLig + 1
              End If
            End If
        Next i
    End With
    '
    End Sub

  13. #13
    Membre averti
    Profil pro
    Inscrit en
    Juin 2010
    Messages
    29
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juin 2010
    Messages : 29
    Par défaut
    Instr bogue...

  14. #14
    Membre averti
    Profil pro
    Inscrit en
    Juin 2010
    Messages
    29
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juin 2010
    Messages : 29
    Par défaut
    En fait je préférerais avoir uniquement les valeurs différentes de "7" "75" "76". Sachant que les autres valeurs peuvent commencer par 7, par 75 et par 76 et qu'il contienne 8 chiffres

  15. #15
    Membre émérite
    Profil pro
    Inscrit en
    Avril 2008
    Messages
    633
    Détails du profil
    Informations personnelles :
    Âge : 57
    Localisation : France

    Informations forums :
    Inscription : Avril 2008
    Messages : 633
    Par défaut
    Bonjour

    et qu'il contienne 8 chiffres
    S'il doivent contenir 8 chiffres, obligatoirement 7, 75 et 73 seront éliminés donc simplement en vérifiant la longueur tu obtiendra le résultat escompté.

    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
     
    Sub ExtraireProduits()
    '
    ' ExtraireProduits Macro
    '
    Dim i As Long, LastLig As Long, NewLig As Long
    Dim Crit As Double
     
    Application.ScreenUpdating = False
    Crit = Sheets("Feuil2").Range("C8").Value
    NewLig = Sheets("Feuil4").Cells(Rows.Count, 1).End(xlUp).Row + 1
    With Sheets("Feuil1")
        LastLig = .Cells(Rows.Count, 1).End(xlUp).Row
        For i = 2 To LastLig
           'Le 7 tous court n'est plus pris en compte
           If Len(.Range("A" & i).Value) = 8 Then
                .Rows(i).Copy Sheets("Feuil4").Range("A" & NewLig)
                NewLig = NewLig + 1
            End If
        Next i
    End With
    '
    End Sub

  16. #16
    Membre averti
    Profil pro
    Inscrit en
    Juin 2010
    Messages
    29
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Juin 2010
    Messages : 29
    Par défaut
    Nikél ça marche merci beaucoup pour ton aide!

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Macro complexe sous excel
    Par FreddyNB dans le forum Macros et VBA Excel
    Réponses: 9
    Dernier message: 26/09/2007, 17h41
  2. Activation des macros sous Excel
    Par Igloobel dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 10/10/2005, 11h44
  3. macro sous excel
    Par julien13200 dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 21/02/2005, 15h49
  4. Macro dans excel permettant de voir si un fichier est ouvert
    Par VirginieGE dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 12/08/2004, 07h51
  5. [VBA-E] macro conversion excel vers csv
    Par baboune dans le forum Macros et VBA Excel
    Réponses: 9
    Dernier message: 15/07/2004, 09h23

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo