Aide en VBA

Question

Bonjour, j'espère que quelqu'un pourra m'aider sur ma recherche.

J'essaie de faire ceci en VBA mais il y a toujours un morceau de ma prog qui ne fonctionne pas avec le reste... Je cherche depuis hier sur le net et dans les livres mais c'Est jamais ce que je cherche.

Bon alors je vais vous l'écrire en mot:

Je veux rechercher la cellule B4 de la feuille 2 dans la plage C4: C30 de la feuil 1

(jusque là tout fonctionne)

Ensuite j'aimerais que la valeur inscrite dans la cellule B5 de la feuil 2 se copie dans la cellule associée à la recherche précédente et ainsi de suite.

Comme par exemple:

Feuil 2
10 kg de colle

Colle = B4
10 = B5

Feuil 1
on retrouve le mot colle avec une certaine quantité à côté
j'aimerais que le 10 prenne sa place.

C'est en fait un petit programme que je suis en train de créer pour la réception de produits qui se met automatiquement dans mon inventaire!


ou pê

Deuxième hypothèse.

Ce peut être:

Rechercher la cellule B4 de la feuil 2 dans d la plage C4: C30 de la feuil 1
lorsque le mot a été trouvé, Aller à la cellule à côté
Ensuite copier la valeur de la cellule B5 de la feuil 2 dans cette cellule (celle d'à côté!)



Merci et j'attends de vos nouvelles impatiemment!!

Gord21 · Answer

Bonsoir,
Pourrais-tu envoyer un fichier exemple (avec ci-joint.fr par exemple)
ce serait plus clair.

michel_m · Answer

bonjour

je suppose que "à coté" veut dire à droite ?

essaies

Sub coller()
Dim ref As String, qte As Single, lig As Byte

With Sheets(2)
    ref = .Range("B4")
    qte = .Range("B5")
End With

With Sheets(1)
    lig = .Columns(3).Find(ref, .Range("C3")).Row
    .Cells(lig, 4) = qte
End With

klodine_39 · Answer

Merci énormément Michel_m

tout fonctionne!! :O)

Bonne journée!!

klodine_39 · Answer

Bonjour!!! j'ai un autre petit problème qu'auparavant j'ai fait à l'aide de ma souris!!! mais avec mon exemple j'avais 20 lignes (c'était pas si pire) mais là mon fichier va en contenir + de 1000!!! Alors vous comprenez!!

j'essaie de faire ceci dans la cellule A5 de la feuille2:

Dans cellule A5 feuille2:
si('Feuille1D5'<'Feuille1E5','Feuille1A5',"")

Dans cellule B5 feuile2:
si('Feuille1D5'<'Feuille1E5','Feuille1B5',"")

Dans la cellule A6 feuille2:
si('Feuille1D6'<'Feuille1E6','Feuille1A6',"")

et ainsi de suite...

j'ai essayé de mettre
i=5
IF('Feuille1D[i]<'Feuille1E[i]','Feuille1A[i]',"")
IF('Feuille1D[i+1]<'Feuille1E[i+1]',Feuille1A[i+1]',"")

et ainsi de suite.. mais ça pas d'lair à fonctionner... 

de plus il faut que je fasse cela autant sur les colonnes que sur les lignes...

Je suis toute mélangé et j'espère que je ne vous ai pas mélangé!!!!

Merci :)

Le Pingou · Answer

Bonjour,  
Au passage, une fonction SI() est sufisante, pas besoin de macro. 
Feuille 2  dans cellule :  
A5:  =SI(Feuil1!$D5<Feuil1!$E5;Feuil1!$A5;"")  
B5:  =SI(Feuil1!$D5<Feuil1!$E5;Feuil1!$B5;"")  
Sélectionner  A5 :B5 et tirer vers le bas sur le nombre de lignes désirées !  

Si macro obligatoire, essayer cette procédure: 
Sub fonctionSiF1()
Dim c As Variant
Sheets("Feuil1").Activate
For Each c In Range("D5:D" & Cells(Cells.Rows.Count, 4).End(xlUp).Row)
If c.Value < c.Offset(0, 1).Value Then
    Sheets("Feuil2").Cells(c.Row, 1) = c.Offset(0, -3).Value
    Sheets("Feuil2").Cells(c.Row, 2) = c.Offset(0, -2).Value
Else
    Sheets("Feuil2").Cells(c.Row, 1) = ""
    Sheets("Feuil2").Cells(c.Row, 2) = ""
End If
Next c
End Sub

Salutations.  
Le Pingou

michel_m · Answer

Bonjour à tous

autre méthode (temps : env 0,1 seconde)

Option Base 1

Sub remodeler()
Dim Derlig As Integer, cptr As Integer
Dim Tablo_in, Tablo_out
With Sheets(1)
    Derlig = .Range("D10000").End(xlUp).Row
    Tablo_in = .Range("D5:E" & Derlig)
End With
ReDim Tablo_out(UBound(Tablo_in), 2)

For cptr = 1 To UBound(Tablo_in)
    If Tablo_in(cptr, 1) < Tablo_in(cptr, 2) Then
        Tablo_out(cptr, 1) = Tablo_in(cptr, 1)
        Tablo_out(cptr, 2) = Tablo_in(cptr, 2)
    End If
Next

With Sheets(2)
    Application.ScreenUpdating = False
    .Range("A5:B10000").Clear
    .Range("A5").Resize(UBound(Tablo_out), 2) = Tablo_out
    .Range("A5:B" & UBound(Tablo_out) + 4).Borders.Weight = xlThin
    .Activate
End With

End Sub


Mais, effectivement, comme le dit fort justement Le Pingou, des formules suffiraient !

klodine_39 · Answer

Je comprends bien ce que vous dites, mais il me semble que je l'ai essayé de drager ma formule jusqu'en bas... mais ça n'avait pas fonctionné.. 

Merci beaucoup pour vos réponses!

klodine_39 · Answer

Non, ça ne fonctionne pas!! Je viens de le faire à la main et excel n'aime pas trop ça!!!

Si je récapitule:

Feuille 2 A5
=si(Feuil1D5<Feuil1E5,Feuil1A5,"")

Feuille 2 B5
=si(Feuil1D5<Feuil1E5,Feuil1B5,"")

Feuille 2 C5
=si(Feuil1D5<Feuil1E5,Feuil1C5,"")

Et ainsi de suite jusqu'à I5

MAIS il y a aussi le fait que sur la ligne suivante (6) ça donne

Feuille 2 A6
=si(Feuil1D6<Feuil1E6,Feuil1A6,"")

Feuille 2 B6
=si(Feuil1D6<Feuil1E6,Feuil1B6,"")

Feuille 2 C6
=si(Feuil1D6<Feuil1E6,Feuil1C6,"")

et ainsi de suite..

Donc mon carré c'est de A5 à IX (X étant 1000 ou 10000 ou)....


C'est ça le mini problème... Je ne peux pas drager en carré car la ligne 1 n'a pas les mêmes coordonnées que la ligne 2 et suivante...

Pouvez vous m'aider encore ???
MErci

Le Pingou · Answer

Bonjour, 
Oui d'accord, jusqu'à la colonne [i], donc il suffit de complèter comme suit: 
Feuille 2 dans cellule :  
A5: =SI(Feuil1!$D5<Feuil1!$E5;Feuil1!$A5;"")  
B5: =SI(Feuil1!$D5<Feuil1!$E5;Feuil1!$B5;"")  
C5: =SI(Feuil1!$D5<Feuil1!$E5;Feuil1!$C5;"")  
...... 
....... 
I5: =SI(Feuil1!$D5<Feuil1!$E5;Feuil1!$I5;"") 
Sélectionner A5 :I5 et tirer vers le bas sur le nombre de lignes désirées ! 
J'ai testé, sa marche sans problème et Excel adore cela.
Salutations. 
Le Pingou

klodine_39 · Answer

Bonjour

Michel_m, ce que tu m'as écrit au début début!! fonctionne très bien!! mais j'essaie de la modifier pour que mon range soit plus d'une cellule à chercher... Ce sont les produits qui ont été commandé donc si on pouvait les réceptionner tous ensemble au lieu de les écrire un par un... Je sais pas si tu comprends...

la "ref" serait B4 à B8 par exemple
et
la "qte" serait de C4 à C8

Merci !! et bonne journée

Le Pingou · Answer

Bonjour,
En restant dans l'esprit de michel_m (bonne ballade...), je vous propose d'essayer cette procédure modifiée :
Sub coller_plus()
Dim ref As String, qte As Single, lig As Byte
Sheets(2).Activate
For Each c In Range("B4:B8")
    ref = c.Value
    qte = c.Offset(0, 1).Value
    With Sheets(1)
        lig = .Columns(3).Find(ref, .Range("C3")).Row
        .Cells(lig, 4) = qte
    End With
Next c
End SubJ'espère que c'est se que vous désirez !

Aide en VBA

11 réponses

Discussions similaires

Newsletters