Fonction recherche vba excel

thecerebral Messages postés 1 Date d'inscription   Statut Membre Dernière intervention   -  
pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   -
Bonjour,
Je cherche à créer differentes macros afin de completer un registre du personnel. J'ai commencé par creer une macro puis on m'a conseillé le vba
Un ami m'a aidé a créer ce code vba pour l'ajout d'un salarié:
' Création_salarié Macro
'

If Sheets("ajout salarié").Cells(12, 3).Value = "OK" Then
Sheets("BASE").Select
Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Sheets("Ajout salarié").Select
Range("B4").Select
Selection.Copy
Sheets("BASE").Select
Range("A2").Select
ActiveSheet.Paste
Sheets("Ajout salarié").Select
Range("B2").Select
Application.CutCopyMode = False
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Sheets("BASE").Select
Range("B2").Select
ActiveSheet.Paste
Sheets("Ajout salarié").Select
Range("B3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BASE").Select
Range("C2").Select
ActiveSheet.Paste
Sheets("Ajout salarié").Select
Range("B7").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BASE").Select
Range("D2").Select
ActiveSheet.Paste
Sheets("Ajout salarié").Select
Range("B8").Select
Application.CutCopyMode = False
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Sheets("BASE").Select
Range("E2").Select
ActiveSheet.Paste
Sheets("Ajout salarié").Select
Range("B9").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BASE").Select
Range("F2").Select
ActiveSheet.Paste
Sheets("Ajout salarié").Select
Range("B10").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BASE").Select
Range("G2").Select
ActiveSheet.Paste
Sheets("Ajout salarié").Select
Range("F2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BASE").Select
Range("H2").Select
ActiveSheet.Paste
Sheets("Ajout salarié").Select
Range("F3").Select
Application.CutCopyMode = False
Selection.Copy
Application.CutCopyMode = False
Selection.Copy
Range("F3").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BASE").Select
Range("I2").Select
ActiveSheet.Paste
Sheets("Ajout salarié").Select
Range("B6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("BASE").Select
Range("K2").Select
ActiveSheet.Paste
Else: MsgBox
End If
End Sub

puis pour faciliter ma tache dans les recherche de personnes j'ai essayé de developper par matricule ( a l'aide de bouquin)

Sub recherche_par_matricule()
Dim B4 As String
Dim Trouve As Boolean
Dim No_ligne As Long
B4 = InputBox("veuillez saisir le matricule", "recherche salarié", "")
Trouve = False
Dim LigneMax As Long
LigneMax = Sheets("recherche salarié").Range("K1").Value
For i = 2 To LigneMax
If Sheets("base").Cells(i, 1).Value = B4 Then
Trouve = True
No_ligne = i
Else
End If
Next i
If Trouve = False Then
MsgBox "Salarié inexistant"
Else
Sheets("recherche salarié").Range("B4") = Sheets("BASE").Cells(No_ligne, 1)
Sheets("recherche salarié").Range("B6").Value = Sheets("BASE").Cells(No_ligne, 9).Value
Sheets("recherche salarié").Range("B7").Value = Sheets("BASE").Cells(No_ligne, 4).Value
Sheets("recherche salarié").Range("B8").Value = Sheets("BASE").Cells(No_ligne, 5).Value
Sheets("recherche salarié").Range("B9").Value = Sheets("BASE").Cells(No_ligne, 6).Value
Sheets("recherche salarié").Range("B10").Value = Sheets("BASE").Cells(No_ligne, 7).Value
Sheets("recherche salarié").Range("B3").Value = Sheets("BASE").Cells(No_ligne, 3).Value
Sheets("recherche salarié").Range("B2").Value = Sheets("BASE").Cells(No_ligne, 2).Value
Sheets("recherche salarié").Range("F3").Value = Sheets("BASE").Cells(No_ligne, 10).Value
Sheets("recherche salarié").Range("F2").Value = Sheets("BASE").Cells(No_ligne, 8).Value

End If

End Sub

Sub enregistrer_modifs()
Dim reponse As Integer
reponse = MsgBox("confirmez", vbYesNoCancel, "Modif salarié")
If reponse = 6 Then
With Sheets("BASE")
.Range(A, No_ligne) = Sheets("recherche salarié").Cells("B4")
.Range().Value = Sheets("recherche salarié").Cells("B6").Value
.Range().Value = Sheets("recherche salarié").Cells("B7").Value
.Range().Value = Sheets("recherche salarié").Cells("B8").Value
.Range().Value = Sheets("recherche salarié").Cells("B9").Value
.Range().Value = Sheets("recherche salarié").Cells("B10").Value
.Range().Value = Sheets("recherche salarié").Cells("B3").Value
.Range().Value = Sheets("recherche salarié").Cells("B2").Value
.Range().Value = Sheets("recherche salarié").Cells("F3").Value
End With
Else
End If
End Sub

Mais malheuresement ces commandes ne fonctionnent pas sa m'a indique erreur d'execution 1004 et j'ai des lignes surlignés en jaune ( la premiere ligne dans enregistrer modifs).

Merci d'avance

2 réponses

  1.
    f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    Bonjour,

    .Range(A, No_ligne) = Sheets("recherche salarié").Cells("B4")
    .Range().Value = Sheets("recherche salarié").Cells("B6").Value
    .

    .Range("A" & No_ligne) si vous avez une variable No_ligne qui existe.

    Autrement exemple
    .Range("A1").Value

    et Cells(4,2) pas Cells("B4")

    .Range().Value marche pas erreur de compilation

    Bonne suite
    0
  2. pijaku Messages postés 13513 Date d'inscription   Statut Modérateur Dernière intervention   2 773
     
    Bonjour,

    1- Vérifiez systématiquement tout vos noms de feuilles dans les syntaxes : Sheets("Nomdelafeuill").
    En effet, je vois des Sheets("base") et des Sheets("BASE"). C'est pas la même chose!!!

    2- il te faut compléter, dans ta sub enregistrement les .range()

    3- Déclarer toutes tes variables : No_ligne n'est pas déclaré dans la sub enregistrement. A non plus...

    4- la syntaxe pour copier coller :
    Range("acopier").copy Range("coller")
    plus simple, plus rapide et plus efficace que tous tes .Select...

    5- un premier "dégrossissage" avec utilisation de la méthode Find pour rechercher plutôt qu'une boucle (cf recherche par matricule): 
    Option Explicit 

Sub Création_salarié() 
' 

If Sheets("ajout salarié").Cells(12, 3).Value = "OK" Then 
    With Sheets("BASE") 
        .Rows("2:2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove 
    End With 
    With Sheets("Ajout salarié") 
        .Range("B4").Copy Sheets("BASE").Range("A2") 
        .Range("B2").Copy Sheets("BASE").Range("B2") 
        .Range("B3").Copy Sheets("BASE").Range("C2") 
        .Range("B7").Copy Sheets("BASE").Range("D2") 
        .Range("B8").Copy Sheets("BASE").Range("E2") 
        .Range("B9").Copy Sheets("BASE").Range("F2") 
        .Range("B10").Copy Sheets("BASE").Range("G2") 
        .Range("F2").Copy Sheets("BASE").Range("H2") 
        .Range("F3").Copy Sheets("BASE").Range("I2") 
        .Range("B6").Copy Sheets("BASE").Range("K2") 
    End With 
Else: MsgBox 
End If 
End Sub 

Sub recherche_par_matricule() 
Dim NumMatr As String 
Dim Trouve As Range 
Dim No_ligne As Long, LigneMax As Long 

NumMatr = InputBox("veuillez saisir le matricule", "recherche salarié", "") 

With Sheets("BASE").Columns(1) 
    Set Trouve = .Cells.Find(NumMatr, lookat:=xlWhole) 
End With 
    If Trouve Is Nothing Then 
        MsgBox "Erreur de saisie - ou salarié inexistant" 
        Exit Sub 
    Else 
        No_ligne = Trouve.Row 
    End If 
    Set Trouve = Nothing 
With Sheets("recherche salarié") 
    .Range("B4") = Sheets("BASE").Cells(No_ligne, 1) 
    .Range("B6").Value = Sheets("BASE").Cells(No_ligne, 9).Value 
    .Range("B7").Value = Sheets("BASE").Cells(No_ligne, 4).Value 
    .Range("B8").Value = Sheets("BASE").Cells(No_ligne, 5).Value 
    .Range("B9").Value = Sheets("BASE").Cells(No_ligne, 6).Value 
    .Range("B10").Value = Sheets("BASE").Cells(No_ligne, 7).Value 
    .Range("B3").Value = Sheets("BASE").Cells(No_ligne, 3).Value 
    .Range("B2").Value = Sheets("BASE").Cells(No_ligne, 2).Value 
    .Range("F3").Value = Sheets("BASE").Cells(No_ligne, 10).Value 
    .Range("F2").Value = Sheets("BASE").Cells(No_ligne, 8).Value 
End With 
End Sub 


Sub enregistrer_modifs() 
Dim reponse As Integer 
reponse = MsgBox("confirmez", vbYesNoCancel, "Modif salarié") 
If reponse = 6 Then 
With Sheets("BASE") 
    '.Range("A" ) = Sheets("recherche salarié").Cells("B4") 
    '.Range().Value = Sheets("recherche salarié").Cells("B6").Value 
    '.Range().Value = Sheets("recherche salarié").Cells("B7").Value 
    '.Range().Value = Sheets("recherche salarié").Cells("B8").Value 
    '.Range().Value = Sheets("recherche salarié").Cells("B9").Value 
    '.Range().Value = Sheets("recherche salarié").Cells("B10").Value 
    '.Range().Value = Sheets("recherche salarié").Cells("B3").Value 
    '.Range().Value = Sheets("recherche salarié").Cells("B2").Value 
    '.Range().Value = Sheets("recherche salarié").Cells("F3").Value 
End With 
Else 
End If 
End Sub


    Cordialement,
    Franck P
    0