Recherchev & somme (VBA)

Lentz -
Lentz - 14 sept. 2011 à 10:52

Bonjour,

Je vous exposé mon probleme, je souhaite réaliser une recherchev sur un fichier en allant chercher l'info dans un autre fichier, (il y a 2 info) je cherche 'simplement a faire la somme des deux mais en VBA !!
Voici ce que j'ai pu réalisé (la recherchev (elle fonctionne))

Sub recherchev()
With Workbooks("2012.xls").Sheets("Feuil1")
.Range("J21").Value = WorksheetFunction.VLookup(.Range("B6").Value, _
Workbooks("Clt dtx v.3 beta.xls").Sheets("CLT DTX").Range("B6:X100"), 9, False)
With Workbooks("2012.xls").Sheets("Feuil1")
.Range("J22").Value = WorksheetFunction.VLookup(.Range("B6").Value, _
Workbooks("Clt dtx v.3 beta.xls").Sheets("CLT DTX").Range("B6:X100"), 11, False)
End With
End With
End Sub

Merci de votre aide :)Lire la suite

Afficher la suite

2 réponses

pijaku Messages postés 13513 Date d'inscription Statut Modérateur Dernière intervention 2 773

Bonjour,
Je suppose, dans la déclaration des variables que vos deux "nombres" à additionner sont des entiers. Si ce n'est pas le cas, il faudra changer le type des variables, en remplaçant Integer (et Long) par Double ou Currency selon...

Sub recherchev()
With Workbooks("2012.xls").Sheets("Feuil1") 
    .Range("J21").Value = WorksheetFunction.VLookup(.Range("B6").Value, _ 
Workbooks("Clt dtx v.3 beta.xls").Sheets("CLT DTX").Range("B6:X100"), 9, False) 
    .Range("J22").Value = WorksheetFunction.VLookup(.Range("B6").Value, _ 
Workbooks("Clt dtx v.3 beta.xls").Sheets("CLT DTX").Range("B6:X100"), 11, False) 
End With 
End Sub 
Sub Ajoute()
Dim Valeur1 As Integer, Valeur2 As Integer
Dim Resultat As Long
With Workbooks("2012.xls").Sheets("Feuil1") 
    Valeur1 = .Range("J21").Value
    Valeur2 = .Range("J22").Value
    Resultat = Valeur1 + Valeur2
    .Range("J23").Value = Resultat
End Sub

Lentz

Merci de ton aide,

Par contre celà est uniquement pour une ligne, si j'en ai plusieurs.. comment créer la boucle ?

Cdt
0

pijaku Messages postés 13513 Date d'inscription Statut Modérateur Dernière intervention 2 773

For - Next...
Exemple :
Tu veux :
- en J21 une recherchev de B6 (colonne 9), en J22 une recherchev de B6 (colonne 11), en J23 la somme des 2,
- en J24 une recherchev de B7 (colonne 9), en J25 une recherchev de B7 (colonne 11), en J26 la somme des 2,
- en J27 une recherchev de B8 (colonne 9), en J28 une recherchev de B8 (colonne 11), en J29 la somme des 2,
Et ceci pour les lignes allant de B6 à B22...
Tu fais donc comme ceci :

Dim LignB as Integer, LignJ As Integer 
LignJ = 21 'première ligne pour la colonne J 
For LignB = 6 to 22 'initialise ta boucle 
    With Workbooks("2012.xls").Sheets("Feuil1")  
        .Range("J" & LignJ).Value = WorksheetFunction.VLookup(.Range("B" & LignB).Value, _  
Workbooks("Clt dtx v.3 beta.xls").Sheets("CLT DTX").Range("B6:X100"), 9, False) 
        LignJ = LignJ + 1  
        .Range("J" & LignJ).Value = WorksheetFunction.VLookup(.Range("B" & LignB).Value, _  
Workbooks("Clt dtx v.3 beta.xls").Sheets("CLT DTX").Range("B6:X100"), 11, False) 
        LignJ = LignJ + 1  
         .Range("J" & LignJ).Value =  .Range("J" & LignJ - 1).Value +  .Range("J" & LignJ - 2).Value 
        LignJ = LignJ + 1 
    End With 
Next LignB

Code non testé...

Lentz

Merci bien :)

Mais je ne sais pas pourquoi il me met une erreur de compilation "Erreur de Syntaxe" à la fin j'ai

End

Else if

End Sub

J'ai essayer de tout changer mais rien ne va .. la macro veut pas se lancer..:/
0
pijaku Messages postés 13513 Date d'inscription Statut Modérateur Dernière intervention 2 773

dans le code que je t'ai donné je ne vois ni "End" ni "Else If"... Je ne peux donc rien faire pour toi si tu ne donnes pas tout ton code..................
0

Lentz

Hum .. ok .. bonne chance lol

Sub Annee_Suivante()
Dim Reponse As Long
Reponse = MsgBox(Prompt:="Êtes-vous sûr de vouloir passer à l'année suivante ?", Title:="Attention", Buttons:=vbYesNo)
If Reponse = vbYes Then
    Application.ScreenUpdating = False
    Dim ThWbk As Workbook
    Set ThWbk = ThisWorkbook
    ThWbk.Activate
    Workbooks.Add
    Sheets("Feuil1").Select
    'Définit la fenêtre "Enregistrer sous"
    Set objSaveBox = Application.FileDialog(msoFileDialogSaveAs)

    With objSaveBox
    'Définit un nom par défaut dans le champ "Nom de fichier".
    .InitialFileName = "Nom fichier.xls"

'Définit le type de fichier par défaut:
    .FilterIndex = 1 'Fichier xls

'Affiche la boîte de dialogue
    .Show
    'Enregistre
     If .SelectedItems.Count > 0 Then
 Fich = Right(.SelectedItems(1), Len(.SelectedItems(1)) - InStrRev(.SelectedItems(1), "\"))
End If


    .Execute


    End With
    Sheets("Feuil1").Select
    Sheets("Feuil1").Name = "Synthèse"
    ActiveWindow.DisplayGridlines = False
    Sheets("Feuil2").Select
    ThWbk.Activate
    Sheets("Synthèse").Select
    Cells.Select
    Selection.Copy
    Range("A1").Select
    Windows(Fich).Activate
    Sheets("Synthèse").Select
    ActiveSheet.Paste
    Cells.Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Range("A1").Select
    Sheets("Feuil2").Select
    ThWbk.Activate
    Sheets("CLT DTX").Select
    ActiveSheet.Unprotect
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("A1").Select
    Windows(Fich).Activate
    Range("B47").Select
    Sheets("Feuil2").Select
    Sheets("Feuil2").Name = "CLT DTX"
    Sheets("CLT DTX").Select
    ActiveWindow.SmallScroll Down:=-9
    Range("A1").Select
    ActiveSheet.Paste
    ActiveWindow.Zoom = 85
    Range("D6").Select
    ActiveWindow.FreezePanes = True
    ActiveWindow.SmallScroll Down:=0
    Rows("6:6").Select
    ActiveWindow.FreezePanes = True
    Range("K4:K6").Select
    Selection.AutoFilter
    ActiveWindow.DisplayGridlines = False
    Range("N6:N5700").Select
    Selection.ClearContents
    Range("A1").Select
With Workbooks(Fich).Sheets("CLT DTX")
    .Range("J21").Value = WorksheetFunction.VLookup(.Range("B6").Value, _
ThWbk.Sheets("CLT DTX").Range("B6:X100"), 9, False)
    .Range("J22").Value = WorksheetFunction.VLookup(.Range("B6").Value, _
ThWbk.Sheets("CLT DTX").Range("B6:X100"), 11, False)
Dim Valeur1 As Integer, Valeur2 As Integer
Dim Resultat As Long
With Workbooks(Fich).Sheets("CLT DTX")
    Valeur1 = .Range("J21").Value
    Valeur2 = .Range("J22").Value
    Resultat = Valeur1 + Valeur2
    .Range("J23").Value = Resultat
Dim LignB As Integer, LignJ As Integer
LignJ = 6 'première ligne pour la colonne J
For LignB = 6 To 250 'initialise ta boucle
    With Workbooks(Fich).Sheets("CLT DTX")
        .Range("J" & LignJ).Value = WorksheetFunction.VLookup(.Range("B" & LignB).Value, _
ThWbk.Sheets("CLT DTX").Range("B6:X100"), 9, False)
        LignJ = LignJ + 1
        .Range("J" & LignJ).Value = WorksheetFunction.VLookup(.Range("B" & LignB).Value, _
ThWbk.Sheets("CLT DTX").Range("B6:X100"), 11, False)
        LignJ = LignJ + 1
         .Range("J" & LignJ).Value = .Range("J" & LignJ - 1).Value + .Range("J" & LignJ - 2).Value
        LignJ = LignJ + 1
    End With
Next LignB
    For n = Range("T65536").End(xlUp).Row To 1 Step -1
 If Range("V" & n) = "X" Then Rows(n).Delete
Next n
    Sheets("Feuil3").Select
    Sheets("Feuil3").Name = "FORMULAIRE"
    ThWbk.Activate
    Sheets("FORMULAIRE").Select
    ActiveSheet.Unprotect
    Cells.Select
    Range("A1").Activate
    Selection.Copy
    Range("A1").Select
    Windows(Fich).Activate
    Sheets("FORMULAIRE").Select
    ActiveSheet.Paste
    Cells.Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    Range("G19:G29").Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Range("A1").Select
    ThWbk.Activate
    Sheets("FORMULAIRE").Select
    Cells.Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    Range("G19:G29").Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("CLT DTX").Select
    Cells.Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    Columns("I:K").Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    Range("N4:N6500").Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    ActiveWindow.ScrollColumn = 2
    ActiveWindow.ScrollColumn = 3
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 12
    Range("W5:W6500").Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Application.ScreenUpdating = True
    Windows(Fich).Activate
    Sheets("CLT DTX").Select
    Cells.Select
    Selection.Locked = True
    Selection.FormulaHidden = False
    Range("I:K").Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    Range("N4:N6500").Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    Range("W5:W6500").Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlUnlockedCells
    Sheets("Synthèse").Select
    Cells.Select
    ActiveSheet.Unprotect
    Selection.Locked = True
    Selection.FormulaHidden = False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlUnlockedCells
    Sheets("FORMULAIRE").Select
    Cells.Select
    ActiveSheet.Unprotect
    Selection.Locked = True
    Selection.FormulaHidden = False
    Range("G19:G29").Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    ActiveSheet.EnableSelection = xlUnlockedCells

End

Else if

End Sub

Réponse 2 / 2
michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention 3 320
bonjour les 2

en utilisant les fonctions VBA (sinon, tu pourrais peut-^tre écrire les formules en J21 et J22)
```
Sub additionner_apres_recherche() 
cherche = Workbooks("2012.xls").Sheets("Feuil1").Range("B6") 
With Workbooks("Clt dtx v.3 beta.xls").Sheets("CLT DTX") 
     On Error GoTo vide: 
     lig = Columns("B").Find(cherche, .Range("B5"), xlValues).Row 
     somme = .Cells(lig, 10) 
     somme = somme + .Cells(lig, 12) 
End With 

With Workbooks("2012.xls").Sheets("Feuil1") 
     .Range("J23") = somme 
End With 

Exit Sub 

vide: 
MsgBox cherche & " inconnu dans le tableau source", vbCritical 
End Sub 
```
"la suite" est trop indigeste :o)
il faudrait que tu teste si le classeur appelé est ouvert...
Michel
0
1. pijaku Messages postés 13513 Date d'inscription Statut Modérateur Dernière intervention 2 773
  
  Salut Michel,
  Merci pour le relais.
  Je confirme, "la suite est indigeste"...
  
  0
2. Lentz
  
  Bah pour mwa ça marche il y a juste à la fin que ça merdouille .. une solution .. ?
  
  Avec la solution de michel, mon problème de fin n'est pas arrangé :/
  
  0
3. michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention 3 320
  
  Très vague ta réponse... sur quelle ligne ça merdouille et de quoi tu parles avec "ton problème de fin"
  
  merci pour le "Bah pour mwa..." ca vaut le coup d'essayer d'aider quelqu'un.
  
  0
4. Lentz
  
  "Merci bien :)
  
  Mais je ne sais pas pourquoi il me met une erreur de compilation "Erreur de Syntaxe" à la fin j'ai
  
  End
  
  Else if
  
  End Sub
  
  J'ai essayer de tout changer mais rien ne va .. la macro veut pas se lancer..:/"
  
  0
5. michel_m Messages postés 18903 Date d'inscription Statut Contributeur Dernière intervention 3 320
  
  merci pour le " Bah pour mwa... " ca vaut le coup d'essayer d'aider quelqu'un
  
  Avec la solution de michel, mon problème de fin n'est pas arrangé
  
  et c'est quoi ton problème de fin, et sur quelle ça merdouille ???
  
  et pourquoi fais tu un doublon avec
  https://forums.commentcamarche.net/forum/affich-23149846-recherche-d-information
  
  0

Recherchev & somme (VBA)

2 réponses

Discussions similaires

Newsletters