Retrouver une valeur dans un tableau

Version imprimable

Voir 40 message(s) de cette discussion en une page

tu pourras aussi changer ton code comme ci-dessous :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub immat_Click()
Dim ch As Range, Der_ligne As Integer
With Sheets("base")
If modele.ListIndex = -1 Then: MsgBox "Chosir d'abord un modele": modele.SetFocus: Exit Sub
Der_ligne = .Range("A" & .Rows.Count).End(xlUp).Row
If dte_sortie = True Then
    Set ch = .Range("a2:h" & Der_ligne).Columns(3).Find(immat)
    If Not ch Is Nothing Then
        chassis = ch.Offset(0, 1): agent_p = ch.Offset(0, 2)
    End If
End If
End With
chassis.SetFocus
End Sub

il y a longtemps que je n'avais pas vu ton fichier et beaucoup d'améliorations sont encore à faire
je viens de voir un autre problème, change ton code du bouton "valider" comme ci-dessous :

Code:

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
Private Sub valid_Click()
Dim Der_ligne As Integer, ch As Range
With Sheets("base")
Der_ligne = .Range("A" & .Rows.Count).End(xlUp).Row + 1
 
    If dte_sortie = True Then
        Set ch = .Range("C1:C" & Der_ligne - 1).Find(immat)
        ch.Offset(0, 4) = CDate(mouvement)
        TRI
    End If
 
    If dte_entree = True Then
        .Cells(Der_ligne, 1) = marque
        .Cells(Der_ligne, 2) = modele
        .Cells(Der_ligne, 3) = immat
        .Cells(Der_ligne, 4) = chassis
        .Cells(Der_ligne, 5) = agent_p
        .Cells(Der_ligne, 6) = CDate(mouvement)
    TRI
        End If
 
    If dte_vo = True Then
        .Cells(Der_ligne, 7) = CDate(mouvement)
    End If
End With
 
End Sub

Bonne journée

11/06/2009, 13h24
Autodidacte_vba

Super je me penche là dessus .

MERCI Casefayere :ccool:
11/06/2009, 14h41
garion28

salut,
j'ai testé ton fichier en y incluant les dernière modification, j'ai une erreur a la ligne:
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _

"projet ou bibliothèque introuvable"

ya des modification suplémentaire qui ont été apporté ?
11/06/2009, 20h05
Autodidacte_vba

Bonsoir

Non j'ai également cette erreur sur un autre de mes pc.

Je ne sais pas pourquoi mais, je pense que c'est du à une version différente d'excel.

A part ça le fichier fonctionne parfaitement.

Je pense essayer la date_vo ,si le code te(vous) parait clair.

Merci à vous .

Casafayere un merci spécial pour ton investissement.

J'avance à mon rythme .

Encore merci
12/06/2009, 00h02
Autodidacte_vba

1 pièce(s) jointe(s)

Bonsoir le forum, Casefayere

j'ai ajouté une saisie emplacement dans le formulaire.

Cela fonctionne très bien.

Je cherche une idée pour la date vo à présent.

Je pense que si le véhicule part en vo, les lignes correspondantes à l'immat seraient effacées ou, mieux, copiées ans une nouvelle feuille.

J'ai tenté en décortiquant une macro ""bricolage"" mais rien de bien convaincant.

Quelle serait la meilleure solution?

Un module comme le module TRI ou bien tout faire à la main?

Si dte_vo est vrai alors on fait ctrl+F et on supprime ttes les entrées une à une?

Merci d avance.

Cordialement.

1 pièce(s) jointe(s)

Bonjour le forum,CAsefayere

Je tente toujours de supprimer (ou mieux coller vers une autre feuille) les lignes dont la colonne date vo est remplie.

Je tente un code comme le suivant. A l'exécution, ma macro sélectionne la plage mais ne supprime pas les lignes voulu.

Je sais que ce code peut vous paraitre bizzare (voir stupide) mais je pense être sur un semblant de bonne voie.

Qu'en pensez vous?

Merci d'avance.
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 Sub supp_vo() Dim i As Integer With Sheets("base") For i = .Range("H" & .Rows.Count).End(xlUp).Row To 2 Step -1 Range("A:I").Select If Range("H" & i).Value = 1 Then .Rows(i).Delete End If Next i End With End Sub
Merci d'avance

Bonjour le forum, autodidacte,

je n'ai pas trop le temps, mais j'ai constaté des erreurs
dans ce code

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub supp_vo()
 
Dim i As Integer
With Sheets("base")
For i = .Range("H" & .Rows.Count).End(xlUp).Row To 2 Step -1' ici si ta derniere cellule n'est pas une date VO
Range("A:I").Select 'inutile et mauvaise syntaxe
If Range("H" & i).Value = 1 Then 'aucune cellule n'est égale à 1
    .Rows(i).Delete
End If
Next i
End With

End Sub
code corrigé

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub supp_vo()
 
Dim i As Integer
With Sheets("base")
For i = .Range("a" & .Rows.Count).End(xlUp).Row To 2 Step -1
 
If Range("H" & i)) <>"" Then
    .Rows(i).Delete
End If
Next i
End With
 
End Sub

bonne journée

1 pièce(s) jointe(s)

Bonsoir le forum, Casefayere :

En fait même si ce code pourrait fonctionner, je me suis rendu compte qu'il ne ferait pas ce que je visais.

J'ai donc tenté de créer un code qui me permette de copier les lignes contenant
une date vo vers une nouvelle feuille (la feuille vo)

J ai un soucis de compilation. Un message m'indique Projet ou Bibliothèque introuvable.

Qu'en pensez vous?
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 Sub Bouton4_Clic() 'Avec la feuille base With Worksheets("Base") 'On déclare ligne vo comme un entier Dim ligne_vo As Integer ligne_vo = 1 'on initialise la ligne de copie à 1 For Each cel In Worksheet("Base").Column("H").Rows 'pour chaque cellule dans la colonne H de la feuille Base If cel <> "" Then 'si cette cellule contient une date (si elle est non vide en fait) ALORS Row.Copy Destination:=vo.Rows(ligne_vo, 1) 'on copie la ligne vers la feuille vo en partant de la ligne vo ligne_vo = ligne_vo + 1 'on ajoute 1 à la valeur de la ligne vo pour remplir la ligne suivante End If Next cel 'on passe à la ligne suivante End With End Sub
Ce code est situé dans le bouton 4 de mon fichier

MERCI D AVANCE.

Bonjour le forum, Autodidacte,
je suis beaucoup absent ces temps-ci, d'où ma réponse tardive, essayes ce code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Bouton4_Clic()
'Avec la feuille base
With Worksheets("Base")
'On déclare ligne vo comme un entier
Dim ligne_vo As Integer, cel As Range
 
ligne_vo = Sheets("vo").Range("a" & Sheets("vo").Rows.Count).End(xlUp).Row
 
    For Each cel In Worksheets("Base").Columns(8).Rows 'pour chaque cellule dans la colonne H de la feuille Base
        If cel <> "" Then 'si cette cellule contient une date (si elle est non vide en fait) ALORS
            .Rows(cel.Row).Copy Destination:=Sheets("vo").Cells(ligne_vo, 1) 'on copie la ligne vers la feuille vo en partant de la ligne vo
            ligne_vo = ligne_vo + 1 'on ajoute 1 à la valeur de la ligne vo pour remplir la ligne suivante
        End If
    Next cel 'on passe à la ligne suivante
End With
End Sub

18/06/2009, 12h41
Autodidacte_vba

Bonjour Casefayere.

De toutes façons, je ne suis pas pressé , je fais ça pour m'apprendre au fur et à mesure. Je commence à y voir plus clair en VBA et je t'en remercie.

Avec toute l'aide que tu m'as apporté j'ai déjà de quoi bosser.

Je te remercie pour ta réponse, aussi tardive soit-elle.

Je bosse dessus voir les différences avec mon code bricolage pour voir ce que j'avais oublié.

Encore merci.

Bonne journée.

edit : il y a des erreurs grosses comme moi, que j'aurais pu corriger moi même , par exemple la colonne H :)

Merci casefayere, je continue à regarder ça

Edit ; Voilà ça fonctionne.

J'ai modifié la façon dont s'effectue le test sur la cellule des colonnes vo.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Sub Bouton4_Clic()
Dim ligne_a_deplacer As Integer
Dim cel As Range
Dim vo
 
ligne_a_deplacer = Sheets("vo").Range("a" & Sheets("vo").Rows.Count).End(xlUp).Row
 
With Sheets("Base")
    For Each cel In .Range("h2:h" & .Range("h" & .Rows.Count).End(xlUp).Row)
        If IsDate(cel) = True Then
        .Rows(cel.Row).Copy Destination:=Sheets("vo").Cells(ligne_a_deplacer, 1)
        ligne_a_deplacer = ligne_a_deplacer + 1
        Else
 
        End If
     Next
End With
End Sub

Je cherche maintenant à supprimer les lignes copiées, je viens vers toi/vous dès que j'ai une ébauche de code.

BOnne soirée.

Bonsoir Autodidacte, le forum

adaptes tout simplement, j'ai repris ton code et adapté

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Bouton4_Clic()
Dim ligne_a_deplacer As Integer, cel As Range
 
ligne_a_deplacer = Sheets("vo").Range("a" & Sheets("vo").Rows.Count).End(xlUp).Row
 
With Sheets("Base")
    For Each cel In .Range("h2:h" & .Range("h" & .Rows.Count).End(xlUp).Row)
        If IsDate(cel) = True Then
            .Rows(cel.Row).Copy Destination:=Sheets("vo").Cells(ligne_a_deplacer, 1)
            .Rows(cel.Row).ClearContents
            TRI 'ta macro tri
            ligne_a_deplacer = ligne_a_deplacer + 1
        End If
     Next cel
End With
End Sub

à plus

Voir 40 message(s) de cette discussion en une page