[VBA-E]Macro pour positionnement cellule

**Micky58** · 23/04/2007, 16h47

Bonjour,
J'ai un tableau sur Excel pour gérer un stock et pour faciliter la recherche du N° d'artiche, lors de l'encodage, il faudrait une petite macro qui en indiquant le N° de l'article dans la cellule "J2" et poussant sur un bouton de macro,le curseur se place directement sur le N° de l'article.
S'il n'existe pas encore se positionner sur la 1ère cellule vide dans la colonne "A".
ps: les n° d'article se trouvent en colonne A

Merçi à vous pour votre aide.
Bonne soirée

**Michel_M** · 23/04/2007, 17h18

Bonjour,

Ci dessous proposition:

Code vba :

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

1
2
3
4
5
6
7
If ActiveCell.Address <> "$J$1" Then: Exit Sub
code = Range("J1")
On Error Resume Next
Columns(1).Find(code).Select
If Error > 0 Then
Cells(Range("A65536").End(xlUp).Row + 1, 1).Select
End If

On pourrait améliorer avec une macro événementielle: tu tapes ton code en J1 et quand tu valides... hop sur la cellule

A+
Michel_M

**Micky58** · 23/04/2007, 18h28

Salut Michel_M j'ai essayé la vba et elle ne fonctionne pas. Il faudrait que quand j'ai encodé le n°art (ex:159) et en valident, elle se rende automatiquement sur la cellule avec l'article (ex:159).
Mais si l'article n'a pas encore été encodé dans le stock, il doit aller à la première ligne libre pour l'introduire et cela ça marche
Merç!

**Michel_M** · 24/04/2007, 09h34

Bonjour Micky

en réponse petite démo dans ce lien
http://www.cijoint.fr/cij64039718611330.xls

en espérant que...

Michel_M

**Micky58** · 24/04/2007, 09h41

Bonjour Michel_M, merçi de suivre mon petit problème.
Ok pour la démo, mais ou est la vba? car celle que tu m'as faite ne se rend pas sur l'article indiqué en "J1"

**Daranc** · 24/04/2007, 10h28

Salut Micky
je pense que le problème est celui-ci
la macro de Michel plante parce que la cible est J1 mais une fois validé le changement c'est J2 qui est active (ou la case qui est reprise par défaut après validation)
j'ai modifié la macro comme suit:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Worksheet_Change(ByVal Target As Range)
Dim code As Variant
If ActiveCell <> Cells(2, 10) Then
Exit Sub
Else
code = Range("j1").Value
On Error Resume Next
Columns(1).Find(code).Select
If Err.Number > 0 Then
Cells(Range("A65536").End(xlUp).Row + 1, 1).Select
End If
End If
End Sub

je ne me rappelle plus comment cibler une seule cellule en changement
attention toutefois la macros telle qu'elle est te pointera le 12 sur le 123 si il se trouve avant le douze
lorsque je te demandais quel est le problème je voulait le titre du fil
Daranc

**Micky58** · 24/04/2007, 10h39

J'ai essayé mais je n'arrive pas donc:
Voilà le fichier dont je souhaite réaliser la vba.
Merçi

Stock.rar

**Michel_M** · 24/04/2007, 13h35

Re,

j'ai re-essayé ma macro, elle marche sauf sur la remarque de Daranc (merci) concernant la valeur 12: j'ai donc paramétré la fonction "find" avec xlwhole et c'est OK

Sur ma machine, l'option de déplacement après validation est toujours supprimée (j'ai toujiours considéré que ce déplacement était parasite)de toutes façons déplacement ou non la valeur de J2 ne rentre pas en ligne de compte puisque le code est saisi en J1....

voici le code

Code :

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

1
2
3
4
5
6
7
8
9
10
Private Sub Worksheet_Change(ByVal Target As Range)
 
If ActiveCell.Address <> "$J$1" Then: Exit Sub
 
On Error Resume Next
Columns(1).Find(Target, , , xlWhole).Select
If Err.Number > 0 Then
Cells(Range("A65536").End(xlUp).Row + 1, 1).Select
End If
End Sub

Cette macro se trouve dans le module feuil1 suite à la demande de Micky d'aller sur le code après validation (macro événementielle)

Bon aprem

Michel

**Micky58** · 24/04/2007, 14h01

Salut Michel_M, j'ai mis le fichier "Stock.rar" pour que tu essayes la vba. Ce qu'il faut surtout c'est que si le N° d'art. n'est pas encore encodé, que la valeur de "J2" s'écrive sur la 1ère cellule libre dans la colonne "A".
Merci à vous de votre aide. Bonne aprem

Stock.rar

**Michel_M** · 24/04/2007, 15h21

Re,

désolé, mais je n'ai pas de dézippeur .rar

ajoute cette ligne

Code :

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

1
2
3
4
 
Cells(Range("A65536").End(xlUp).Row + 1, 1).Select
activecell=range("J1").value
End If

Au départ tu me parlais de J1, maintenant c'est J2 et moi je ne pige plus.
peut être je répète: lle fait de décaler après validation est parasite; outils -options- modifications et tu décoches déplacer après validation

Michel

**Micky58** · 24/04/2007, 16h56

Toutes mes excuses, j'ai corrigé ma faute sur le 1er message.
Bonne soirée

**Micky58** · 24/04/2007, 18h32

Merci à tous ceux qui m'ont aidé à solutionner mon problème de vba sur Excel.
Bonne soirée

Invité · 24/04/2007, 19h44

Re Micky58,

Content que vous soyez satisfait du code.

A toutes fins utiles c'est celui-ci :

Sub Rech_art()
Dim pl As Long
Dim art1, art2 As Variant

Sheets("Stoks").Activate

art1 = Cells(2, 10)
pl = 5

Cherch:
art2 = Cells(pl, 1)
If IsEmpty(art2) Then
MsgBox "Article " & art1 & " non trouvé. Il a été ajouté en fin de fichier."
Range(Cells(pl, 1), Cells(pl, 1)).Select
Rows(pl).Select
Selection.Insert Shift:=xlDown
Cells(pl, 1) = art1
Exit Sub
Else
If art2 = art1 Then
Range(Cells(pl, 1), Cells(pl, 1)).Select
Exit Sub
Else
If art2 > art1 Then
Rows(pl).Select
Selection.Insert Shift:=xlDown
Cells(pl, 1) = art1
MsgBox "Article " & art1 & " non trouvé. Il a été ajouté entre 2 articles existants."
Range(Cells(pl, 1), Cells(pl, 1)).Select
Exit Sub
End If
pl = pl + 1
GoTo Cherch
End If
End If

End Sub

Amicalement.

**Micky58** · 25/04/2007, 09h29

Ok merci Jacques_Jean, j'attends la dernière version avec l'insertion de ligne formules comprises.
Bonne journée @+

**Daranc** · 25/04/2007, 10h59

Envoyé par Michel_M

désolé, mais je n'ai pas de dézippeur .rar

Izarc y dezip tout

Daranc

Invité · 25/04/2007, 11h35

Bonjour Micky58,

Sub Rech_art()
Dim pl As Long
Dim art1, art2 As Variant

Sheets("Stoks").Activate

art1 = Cells(2, 10)
pl = 5

Cherch:
art2 = Cells(pl, 1)
If IsEmpty(art2) Then
MsgBox "Article " & art1 & " non trouvé. Il a été ajouté en fin de fichier."
'Range(Cells(pl, 1), Cells(pl, 1)).Select
Rows(pl).Select
Selection.RowHeight = 17
Range(Cells(pl - 1, 1), Cells(pl - 1, 6)).Select
Selection.Copy
Range(Cells(pl, 1), Cells(pl, 1)).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False
Cells(pl, 1) = art1
Cells(pl, 3) = ""
Cells(pl, 4) = ""
Cells(pl, 6) = ""
Exit Sub
Else
If art2 = art1 Then
Range(Cells(pl, 1), Cells(pl, 1)).Select
Exit Sub
Else
If art2 > art1 Then
Rows(pl).Select
Selection.Insert Shift:=xlDown
Selection.RowHeight = 17
Range(Cells(pl - 1, 1), Cells(pl - 1, 5)).Select
Selection.Copy
Range(Cells(pl, 1), Cells(pl, 1)).Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False _
, Transpose:=False
Cells(pl, 1) = art1
Cells(pl, 3) = ""
Cells(pl, 4) = ""
Cells(pl, 6) = ""
MsgBox "Article " & art1 & " non trouvé. Il a été ajouté entre 2 articles existants."
Range(Cells(pl, 1), Cells(pl, 1)).Select
Exit Sub
End If
pl = pl + 1
GoTo Cherch
End If
End If

End Sub

Les formules et le format sont copiés.
Bonne journée.
Amicalement.

**Micky58** · 25/04/2007, 11h54

Bonjour Jacques_jean,
vba bien reçue et elle fonctionne à merveille. Félicitation pour ton exellent travail et je te REMERCIE pour tout.

Bonne journée et à bientôt sur ce merveilleux forum

[VBA-E]Macro pour positionnement cellule

Macros et VBA Excel

Discussions similaires

Partager

Partager