EXTRAIRE dans 2 colonnes des lignes [Résolu] - VB / VBA

A voir également:Extraire dans 2 colonnes des lignes[XL]concaténer 2 colonnes de lignes variables dans une troisième ✓ - Forum - VB / VBA Excel 2007 figer 2 colonnes + 1 ligne ✓ - Forum - Excel Excel comparer deux colonnes ligne par ligne ✓ - Forum - Excel Comparaison 2 colonnes excel+alignement ✓ - Forum - Programmation EXCEL COMPARER DEUX COLONNES VALEURS ? ✓ - Forum - Programmation

Bonjour,
Comment faire en vb dans Excel pour extraire des lignes en recherchant sur 2 colonnes?



En colonne C « N°Semaine/Lot » les 2 premiers chiffres correspondent à la semaine de fabrication.

Je voudrais extraire les Noix et ROSETTE ( colonneB"Produit") ayant 7 semaines de moins que la semaine actuelle :Nous sommes en sem 24
Donc 24-7=17 donc extraire toutes les semaines commençant par 17 et inférieur de la colonneC"N°Semaine/Lot"

Et aussi extraire les Bœufs(colonne B "Produit") ayant 11 semaines de moins que la semaine actuelle :
Donc 24-11=13 donc tous les bœufs commençant par 13 et inférieur toujours en colonne C"semaine"


Merci

Cordialement
Geoffroy

Forum

A voir également:Extraire dans 2 colonnes des lignes[XL]concaténer 2 colonnes de lignes variables dans une troisième ✓ - Forum - VB / VBA Excel 2007 figer 2 colonnes + 1 ligne ✓ - Forum - Excel Excel comparer deux colonnes ligne par ligne ✓ - Forum - Excel Comparaison 2 colonnes excel+alignement ✓ - Forum - Programmation EXCEL COMPARER DEUX COLONNES VALEURS ? ✓ - Forum - Programmation

Web: www.shapebootstrap.net

1 réponse

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

Bonjour,

En vba on boucle sur la colonne C et l'on met les résultats colonne F (a adapter):

Option Explicit Private Sub CommandButton1_Click() For_X_to_Next_Ligne End Sub Sub For_X_to_Next_Ligne() Dim FL1 As Worksheet, NoCol As Integer Dim NoLig As Long, Var As Variant Dim ns As Integer 'numero semaine Dim nombre As Integer '2 caracteres à gauche Dim result As Integer ns = NoSem(Now)      Set FL1 = Worksheets("Feuil1") 'adapter nom feuille     NoCol = 3 'lecture de la colonne C     For NoLig = 2 To Split(FL1.UsedRange.Address, "$")(4)         Var = FL1.Cells(NoLig, NoCol)       result = ns - 7         nombre = Left(Var, 2)         If nombre <= result Then        If FL1.Cells(NoLig, NoCol - 1) = "Rosette" Or FL1.Cells(NoLig, NoCol - 1) = "Noix" Then         FL1.Cells(NoLig, NoCol + 3) = "extraction 7" 'adapter colonne résultat         End If         End If         result = ns - 11         If nombre <= result Then         If FL1.Cells(NoLig, NoCol - 1) = "Boeuf" Then         FL1.Cells(NoLig, NoCol + 3) = "extraction 11" 'adapter colonne résultat         End If         End If     Next     Set FL1 = Nothing End Sub Public Function NoSem(UneDate As Date) As Integer    On Error Resume Next    NoSem = CInt(Format(UneDate, "ww", vbMonday, vbFirstFourDays))    'Verification du bug, reconnu par MS, sur Oleaut32.dll    If NoSem > 52 Then       If CInt(Format(UneDate + 7, "ww", vbMonday, vbFirstFourDays)) = 2 Then NoSem = 1    End If End Function 


Voilà

Reply
réponses:
  • auteur

  • auteur

    Bonsoir,
    Merci beaucoup mais j'ai une petite erreur 13



    que dois-je rectifier?
    encore merci pour ton aide

    A+
    Geoffroy

  • auteur

    Déclare ta variable comme ceci:

    Dim nombre As String '2 caracteres à gauche


    ou

    Dim nombre As Variant '2 caracteres à gauche

  • auteur

    Ok
    j'ai mis variant si non même erreur.
    Par contre pour voir les lignes extraites que dois-je modifier car là rien :)
    ça ne plante pas.
    si c'est possible de mettre les lignes extraites dans une autre feuille exemple "extraction"
    merci

  • auteur

    Voilà un classeur exemple à adapter:

    https://www.cjoint.com/c/IFlqpWIfopQ

    @+ Le Pivert

  • auteur

    Bonsoir,
    et merci beaucoup pour ton aide mais j'ai un petit souci avec ta macro.
    ci-joint le fichier
    https://www.cjoint.com/c/IFnrj5zhMZs

    j'ai ajouté une petite explication en espérant d'être clair
    @+
    Geoffroy

  • auteur

    Pour que cela fonctionne, il faut que le mot recherché soit exactement le même que sur la feuille (majuscule, minuscule etc.)
    Pour le tri tu fais un clic droit sur Produit- Trier et là tu as une boite de dialogue qui te permet de faire ce que tu désires.
    Voici le nouveau code, j'ai mis BŒUF dans les cellules qui n'y était pas:

    Sub For_X_to_Next_Ligne() Dim FL1 As Worksheet, NoCol As Integer Dim FL2 As Worksheet Dim NoLig As Long, Var As Variant Dim ns As Integer 'numero semaine Dim nombre As Integer '2 caracteres à gauche Dim result As Integer ns = NoSem(Now)     Set FL2 = Worksheets("Feuil2") 'adapter nom feuille     Set FL1 = Worksheets("Feuil1") 'adapter nom feuille     NoCol = 3 'lecture de la colonne C     For NoLig = 2 To Range("C1").End(xlDown).Row         Var = FL1.Cells(NoLig, NoCol)       result = ns - 7         nombre = Left(Var, 2)         If nombre <= result Then        If FL1.Cells(NoLig, NoCol - 1) = "NOIX" Or FL1.Cells(NoLig, NoCol - 1) = "BARRE A TRANCHER RA" Then         FL2.Range("A" & NoLig & ":M" & NoLig).Value = FL1.Range("A" & NoLig & ":E" & NoLig).Value         'FL1.Range("A" & NoLig & ":M" & NoLig).ClearContents 'efface         End If         End If         result = ns - 11         If nombre <= result Then         If FL1.Cells(NoLig, NoCol - 1) = "BŒUF" Then         FL2.Range("A" & NoLig & ":M" & NoLig).Value = FL1.Range("A" & NoLig & ":E" & NoLig).Value        ' FL1.Range("A" & NoLig & ":M" & NoLig).ClearContents 'efface         End If         End If     Next     Set FL1 = Nothing End Sub


    Tu peux aussi te servir d'une InputBox pour remplacer les noms en dur Noix etc.
    A ce moment là tu ne feras q'une sélection à la fois
    A toi de voir!

    https://www.commentcamarche.net/faq/41585-vba-inputbox#cas-particulier-la-methode-application-inputbox

    @+

  • auteur

    Voici le code avec 2 InputBox :
    un pour le nom du produit et le second pour les semaines à déduire.
    J'ai mis de nombreux commentaires pour la compréhension


    Sub For_X_to_Next_Ligne() Dim FL1 As Worksheet, NoCol As Integer Dim FL2 As Worksheet Dim NoLig As Long, Var As Variant Dim ns As Integer 'numero semaine Dim Nombre As Integer '2 caracteres à gauche Dim result As Integer 'nombre avec déduction nbre de semaine Dim semaine As Integer 'nbre semaine à déduire Dim Plage As Range 'cellule produit Dim nom As String 'nom du produit à extraire       Set Plage = Application.InputBox("Sélectionnez un produit à extraire", "Sélection du produit à extraire", Type:=8)      nom = Plage.Value    semaine = Application.InputBox("Entrez un nombre de semaine à déduire: ", "Saisie numérique 7 ou 11", Type:=1) ns = NoSem(Now)     Set FL2 = Worksheets("Feuil2") 'adapter nom feuille     Set FL1 = Worksheets("Feuil1") 'adapter nom feuille     NoCol = 3 'lecture de la colonne C     For NoLig = 2 To Range("C1").End(xlDown).Row 'démarre 2 ème ligne         Var = FL1.Cells(NoLig, NoCol)       result = ns - semaine 'semaine à déduire         Nombre = Left(Var, 2) '2 caracteres à gauche         If Nombre <= result Then        If FL1.Cells(NoLig, NoCol - 1) = nom Then 'nom du produit à extraire         FL2.Range("A" & NoLig & ":M" & NoLig).Value = FL1.Range("A" & NoLig & ":E" & NoLig).Value 'plage de cellules à extraire dans Feuille2         'FL1.Range("A" & NoLig & ":M" & NoLig).ClearContents 'efface         End If         End If     Next     Set FL1 = Nothing     Set FL2 = Nothing End Sub Public Function NoSem(UneDate As Date) As Integer    On Error Resume Next    NoSem = CInt(Format(UneDate, "ww", vbMonday, vbFirstFourDays))    'Verification du bug, reconnu par MS, sur Oleaut32.dll    If NoSem > 52 Then       If CInt(Format(UneDate + 7, "ww", vbMonday, vbFirstFourDays)) = 2 Then NoSem = 1    End If End Function  


    Voilà

    @+ Le Pivert

  • auteur

    Bonjour,
    merci je vais tester tout ça.
    Pour le tri je me suis mal exprimé...
    ce tri là c'est le tri classique d'Excel.
    j'aimerais choisir les produits.
    Supposons que cette semaine je dois commencer par le 'Boeuf', puis, 'Noix' et enfin les 'BARRE A TRANCHER RA'
    J'aurais voulu que ça imprime les lignes 'BOEUF' en premiers puis 'NOIX et enfin 'BARRE A TRANCHER RA'
    la semaine suivante je dois commencer par les 'BARRE A TRANCHER RA','BOEUF' et 'NOIX'
    donc 'BARRE A TRANCHER RA' en première ligne, puis, BOEUF et enfin NOIX.

    je vais essayer d'ajouter une colonne avec N° de priorité demandé
    je ne sais pas trop si je suis clair dans mes explications?

    encore merci
    @+
    Geoffroy

  • auteur

    RE
    Pour que cela fonctionne, il faut que le mot recherché soit exactement le même que sur la feuille (majuscule, minuscule etc.)
    OUI j'avais compris mais cela ne va pas pour ce que je veux faire.
    Pouvoir taper juste "BARRE' au lieu de "BARRE A TRANCHER RA" pour avoir tout ce qui commence par 'BARRE' ou même 'Barre' car les MAJUSCULE et minuscule sont souvent mélangé dans les données.
    Mais Super Sympa de passé du temps pour mes "casses têtes" :)
    Pour le tri on peut peut-être demandé avec un InputBox comme tu me la signalé ci-dessus et insérer les N° (1,2,3 ou4)dans la colonne F correspondant aux priorité, par exemple?
    puis trier par cette colonne F

    par contre là je ne sais pas comment faire :)
    merci
    et surtout prends tout ton temps ce n'est pas pressé
    cool
    Bon WE
    @+ Geoffroy

  • auteur

    Pour le tri, le plus simple appeler par ordre de priorité et le mettre dans la feuille2 à la suite comme ceci:

    Sub For_X_to_Next_Ligne() Dim FL1 As Worksheet, NoCol As Integer Dim FL2 As Worksheet Dim NoLig As Long, Var As Variant Dim ns As Integer 'numero semaine Dim Nombre As Integer '2 caracteres à gauche Dim result As Integer 'nombre avec déduction nbre de semaine Dim semaine As Integer 'nbre semaine à déduire Dim Plage As Range 'cellule produit Dim nom As String 'nom du produit à extraire Dim derligne As Long 'dernière lignefeuill2       Set Plage = Application.InputBox("Sélectionnez un produit à extraire", "Sélection du produit à extraire", Type:=8)     nom = Plage.Value    semaine = Application.InputBox("Entrez un nombre de semaine à déduire: ", "Saisie numérique 7 ou 11", Type:=1) ns = NoSem(Now)     Set FL2 = Worksheets("Feuil2") 'adapter nom feuille     Set FL1 = Worksheets("Feuil1") 'adapter nom feuille     NoCol = 3 'lecture de la colonne C     For NoLig = 2 To Range("C1").End(xlDown).Row 'démarre 2 ème ligne         Var = FL1.Cells(NoLig, NoCol)       result = ns - semaine 'semaine à déduire         Nombre = Left(Var, 2) '2 caracteres à gauche         If Nombre <= result Then        If FL1.Cells(NoLig, NoCol - 1) = UCase(nom) Then   'nom du produit à extraire          derligne = FL2.Range("A" & Rows.Count).End(xlUp).Row + 1 'dernière lignefeuill2 + 1         FL2.Range("A" & derligne & ":M" & derligne).Value = FL1.Range("A" & NoLig & ":E" & NoLig).Value 'plage de cellules à extraire dans Feuille2         'FL1.Range("A" & NoLig & ":M" & NoLig).ClearContents 'efface         End If         End If     Next     Set FL1 = Nothing     Set FL2 = Nothing End Sub


    mais pour cela c'est plus compliqué. C'est l'usine à gaz.

    OUI j'avais compris mais cela ne va pas pour ce que je veux faire.
    Pouvoir taper juste "BARRE' au lieu de "BARRE A TRANCHER RA" pour avoir tout ce qui commence par 'BARRE' ou même 'Barre' car les MAJUSCULE et minuscule sont souvent mélangé dans les données.


    Déjà mettre toute la colonne en majuscule, c'est simple.

    Voilà pour l'instant

  • auteur

    Voici un exemple avec une UserForm et une listbox multiselect pour gérer plusieurs choix en même temps:

    https://www.cjoint.com/c/IFopyec8LwQ

    @+ Le Pivert

  • auteur

    Merci
    C'est super ce que tu as fait et rapide BRAVO! :)

    Par contre peut-on l'améliorer ?
    - En évitant les doublons dans la liste et surtout un seul clic afin d'éviter d'extraire plusieurs fois le même.
    - à chaque clic le produit disparaît de la liste?
    - si la colonne est vide pas de plantage

    Mais encore une fois ne te prends pas la "tête" et prends ton temps.
    c'est déjà Super sympa d'aider .

    Par contre, encore un truc qui me tracasse ;)
    pour aller à la dernière ligne tu mets ce code ci-dessous
    'derligne = FL2.Range("A" & Rows.Count).End(xlUp).Row + 1'

    dans ta ligne le curseur se positionne en colonne A et à la dernière ligne d'écrite+1...(c'est bien ça?)
    si je veux maintenant me déplacer de 4 colonnes à droite soit à la colonne E, par exemple (car la colonne E est vide)
    comment fait-on dans ce cas là?
    merci
    A+

  • auteur

    - En évitant les doublons dans la liste et surtout un seul clic afin d'éviter d'extraire plusieurs fois le même.

    Il y a autant de produits que sur la feuille!

    mettre dans la

    Private Sub CommandButton1_Click()


    a la fin ceci:

      Unload UserForm1    End Sub


    à chaque clic le produit disparaît de la liste?

    activer cette ligne:

     'FL1.Range("A" & NoLig & ":M" & NoLig).ClearContents 'efface


    - si la colonne est vide pas de plantage

    avec cette ligne:

     If nom = "" Then Exit Sub


    corrige cette ligne:

     FL2.Range("A" & derligne & ":M" & derligne).Value = FL1.Range("A" & NoLig & ":E" & NoLig).Value 'plage de cellules à extraire dans Feuille2


    par

     FL2.Range("A" & derligne & ":M" & derligne).Value = FL1.Range("A" & NoLig & ":M" & NoLig).Value 'plage de cellules à extraire dans Feuille2


    je n'ai pas compris la dernière question!

    @+ Le Pivert

  • auteur

    Bonjour,
    merci beaucoup
    la dernière question c'est bon j'ai trouvé.
    Bon WE
    A+

  • auteur

    En évitant les doublons dans la liste

    si tu parles de la listBox

    voir remplir une listBox sans doublon

    https://silkyroad.developpez.com/VBA/ControlesUserForm/#LII-G

    Bon WE

    @+ Le Pivert

  • auteur

    Supposons que cette semaine je dois commencer par le 'Boeuf', puis, 'Noix' et enfin les 'BARRE A TRANCHER RA'

    j'ai trouvé la solution en déplaçant les item vers le haut ou vers le bas.
    Exemple à télécharger:

    https://www.cjoint.com/c/IFqjh01pU0Q

    Voilà

    @+ LePivert

  • auteur

    Bonjour,
    Excellent travail, merci
    un dimanche en plus, respect :)

    je vais encore abuser de ton temps :)

    Quand ton sélectionne le produit dans la "ListBox1" peut-on l'effacer (dans cette"ListBox1") une fois cliqué sur "extraire"
    car si non, j'extrais à l'infini le même produit
    Mais encore une fois BRAVO!
    et merci

  • auteur

    comme ceci:

    'extraire Private Sub CommandButton1_Click()  Dim i As Byte  Dim j As Integer   If OptionButton1.Value = True Then      semaine = 7     Else     semaine = 11 End If     'boucle sur les éléments de la listbox     For i = 0 To ListBox1.ListCount - 1         If ListBox1.Selected(i) = True Then         nom = ListBox1.List(i)         For_X_to_Next_Ligne         End If     Next i     Label2.Visible = False Label3.Visible = False CommandButton1.Enabled = False    ' Unload UserForm1     For j = ListBox1.ListCount - 1 To 0 Step -1     If ListBox1.Selected(j) = True Then     'on Supprime l'élément selectionné dans la ListBox.     ListBox1.RemoveItem (j)     End If Next j   Label1.Caption = "Nbre produits: " & ListBox1.ListCount    End Sub


    Voilà

    @+ Le Pivert

  • auteur

    Excellent!
    Merci
    A+

  • auteur

    Bonsoir,
    Maintenant j’aurais besoin d’une sécurité :
    Avec VBA je renomme ma feuille par « toto »
    Plantage, si j’ai déjà une feuille du même nom « toto »
    Comment fait-on pour m’indiquer de changer de nom ou supprimer l’ancien « toto » sans plantage ?
    Merci

  • auteur

    Nouvelle question, nouveau post!

    Si ta demande est résolue, cliques sur Résolu dans la roue crantée en haut à droite.

    Pour répondre brièvement à ta question, regarde ce site pour faire une boucle sur toutes les feuilles et voir si un onglet existe à ce nom

    https://silkyroad.developpez.com/VBA/FeuilleDeCalcul/#LI

    Voilà

    @+ Le Pivert

  • auteur

    Bonsoir,
    Désolé j'avais oublié

    par contre si tu as encore du temps à me consacrer?
    Peut-tu peaufiner cette macro par ceci?

    1- si la feuille2 est vide (juste les titres) et qu'on lance la macro en feuille1 -->plantage
    1b on extrait un produit puis on clic sur feuille2 et on continu à extraire les autres produits--> pas d'extraction à 100% certains produits manquent


    2- quand on passe de feuille2 à feuille1 il faudrait que les données dans la listBox restent dans feuille1
    2b- par exemple je lance la macro dans la feuille2 ( avec quelques données dans cette feuille2) la listBox prendra dans la feuille2 et non dans la feuille1.

    3- ajouter une option: "modifier la semaine de séchage "
    3b - par "Nombre de semaine de séchage="

    4- Changer les options "7 de semaines " et "11 semaines"
    par : Nombre de semaine de séchage= le Nombre qui s'affiche automatiquement quand on sélectionne un produit)

    produit "BARRE A TRANCHER RA ", "BARRE A TRANCHER VPF " ou "NOIX " sélectionné Le chiffre 7 s'affiche à côté de Nombre de semaine de séchage= 7

    produit " Boeuf" sélectionné --> idem mais le nombre"11"
    Nombre de semaine de séchage= 11

    5- ajouter une 2 ème option: "MANQUANT de la semaine dernière"

    je pense qu'avec (NoSem -1 )on peut extraire à nouveau les anciens en les mettant en pole position


    Voilà
    merci

    @+ Geoffroy

  • auteur

    Pour la 1 et 2 mettre ceci dans le bouton extraire:

    'extraire Private Sub CommandButton1_Click()  Dim i As Byte   Dim j As Integer     Worksheets("Feuil1").Activate


    pour la 3 et 4, comment veux-tu que je le sache. Il faut mettre cela dans une colonne.

    et la 5 c'est sensé faire quoi?

    Toutes les questions que tu poses, il n'y a que toi qui puisse les résoudre!

  • auteur

    Oups, je me suis très mal exprimé. Désolé
    Je vais revoir tout ça et essayer d'être un peu plus clair.
    Merci
    A+

  • auteur

    Bonsoir,



    J'espère que c'est un peu plus clair.
    et merci beaucoup
    @+

  • auteur

    Pour l'ouverture mettre ceci en remplacement. C'est exactement la même procédure que pour extraire: on active la feuille 1, c'est simple:

    Private Sub UserForm_Initialize()      Dim Cell As Range     Dim Unique As New Collection     Dim Valeur As Range     Dim i As Integer     Worksheets("Feuil1").Activate 'on active la feuille1     mettre_majuscules      'Récupère la derniere ligne non vide dans la colonne B     i = Worksheets("Feuil1").Range("B" & Rows.Count).End(xlUp).Row      On Error Resume Next     'boucle sur les cellules de la colonne B     For Each Cell In Range("B2:B" & i)         'Stocke les données dans une collection         '(La collection n'accepte que des données uniques et permet donc         ' de filtrer facilement les doublons).         Unique.Add Cell, CStr(Cell)     Next Cell     On Error GoTo 0     'Boucle sur le contenu de la collection pour alimenter la ListBox     For Each Valeur In Unique         Me.ListBox1.AddItem Valeur     Next Valeur     Label1.Caption = "Nbre produits: " & ListBox1.ListCount End Sub


    Pour les semaines, il n'y a que BŒUF qui a 11 semaines?

    @+

  • auteur

    Merci,
    oui c'est simple mais faut connaitre (quoique, si j'avais un peu réfléchi, ça semble tellement logique).

    Oui seulement le boeuf= 11semaines mais apparemment ils ont encore changé dans leurs temps de séchage.
    c'est pour cette raison que je voulais dans la UserForme un bouton Pour saisir le nouveau temps de séchage.

    en tout cas ça fonctionne bien, pour le moment pas de plantage ;)

    j'ajouterais un nouveau sujet pour les 'dim' à 3 dimensions, là encore je mis perds un peu ... :)

    @+

  • auteur

    voilà le classeur avec une TextBox pour entrez le nombre de semaines de séchage pour le BŒUF :

    https://www.cjoint.com/c/IFurbKvmL2Q

    @+ Le Pivert

  • auteur

    Bonjour,
    OK
    Donc ça peut aussi servir pour les autres, si j'enlève cette ligne 'If nom = "BŒUF" Then' ou la remplacer par (???) ?
    merci
    @+ Geoffroy

  • auteur

    Dans ce cas il n'y a qu'un élément à traité, le If Then Else End If suffit. pour plusieurs élément se servir du Select case

    https://excel-malin.com/tutoriels/vba-tutoriels/vba-select-case-mode-d-emploi/

    Voilà

    @+ le Pivert

  • auteur

    Excellent !

    Merci
    @+

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed