Recherche cellules successives conditionnant un programme VBA Résolu

Question

Bonjour tout le monde, je débute sur VBA et ainsi je ne maitrise pas toutes les subtilités de celui-ci. Je viens donc demander votre aide pour simplifier mon problème.
Dans mon excel, j'ai une première feuille sur laquelle je peux saisir 3 variables (Ti, Ta, HTC qui sont des nombres) dont les cellules se suivent (dans une colonne).
Ti      5
Ta    40
HTC  30
Ma deuxième feuille est une base de données dans laquelle on retrouve les 3 cellules (Ti,Ta,HTC) avec des valeurs fixes et un tableau de données correspondant à ces variables.
Je voudrais que ces 3 cellules (sheet1) me permettent de chercher dans toute ma sheet2  les données correspondantes à ces valeurs. 
Cela donnerait quelque chose comme ça : cherche dans sheet2, si 3 cellules (sheet2) qui se suivent (colonne) sont égales aux 3 cellules de la sheet1, renvoyer le tableau correspondant.

Actuellement j'ai créé une macro à base de 'if' qui fonctionne comme je le souhaite mais je dois prendre individuellement chaque groupe de cellules sur sheet2 pour que ca fonctionne. Etant donné que j'ai des centaines de tableaux je ne peux pas faire ça sans avoir un code très long et répétitif. Ici je ne l'ai fait que pour 2 tableaux.

 
Sub macroA()
If Sheets("Sheet1").Range("D8") = Sheets("Sheet2").Range("D5") And Sheets("Sheet1").Range("D9") = Sheets("Sheet2").Range("D6") And Sheets("Sheet1").Range("D10") = Sheets("Sheet2").Range("D7") Then
    Sheets("Sheet2").Select
    Range("C8:F12").Select
    Selection.Copy
    Sheets("Sheet1").Select
    Range("C15:F19").Select
    ActiveSheet.Paste
End If

If Sheets("Sheet1").Range("D8") = Sheets("Sheet2").Range("D15") And Sheets("Sheet1").Range("D9") = Sheets("Sheet2").Range("D16") And Sheets("Sheet1").Range("D10") = Sheets("Sheet2").Range("D17") Then
    Sheets("Sheet2").Select
    Range("C18:F22").Select
    Selection.Copy
    Sheets("Sheet1").Select
    Range("C15:F19").Select
    ActiveSheet.Paste
End If
End Sub


Comment faire pour raccourcir ce programme? 

Je vous remercie de votre attention

Patrice33740 · Answer

Bonjour,

Regardes ici :
https://www.commentcamarche.net/faq/29493-utiliser-cjoint-pour-heberger-des-fichiers#q=cjoint&cur=2&url=%2F

Patrice33740 · Answer

Bonjour,

Essaies ce code :
Option Explicit
Sub macroA()
Const s1 As String = "Ti"
Const s2 As String = "Ta"
Const s3 As String = "HTC "
Dim c1 As Range
Dim c2 As Range
Dim r1 As Range
Dim r2 As Range
Dim a2 As String
Dim ok As Boolean
  Set r1 = Worksheets("Sheet1").Range("C15:F19")
  Set c1 = Worksheets("Sheet1").Range("D8")
  r1.Clear
  Set r2 = Worksheets("Sheet2").UsedRange
  Set c2 = r2.Find(s1, , xlValues, xlWhole)
  If Not c2 Is Nothing Then
    a2 = c2.Address
    Do
      ok = c2.Offset(1).Formula = s2
      ok = ok And c2.Offset(2).Formula = s3
      ok = ok And c2.Offset(0, 1).Value = c1.Value
      ok = ok And c2.Offset(1, 1).Value = c1.Offset(1).Value
      ok = ok And c2.Offset(2, 1).Value = c1.Offset(2).Value
      If ok Then
        c2.Offset(3).Resize(r1.Rows.Count, r1.Columns.Count).Copy r1
        Exit Do
      End If
      Set c2 = r2.FindNext(c2)
    Loop While c2.Address <> a2
  End If
End Sub

Recherche cellules successives conditionnant un programme VBA

2 réponses

Discussions similaires

Newsletters