MacroOUfonction

zineb009 Messages postés 4 Date d'inscription   Statut Membre Dernière intervention   -  
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   -
Bonjour,

Dans la Feuil2 j'ai en colonne A des pays en A3 j'ai United Kingdom et je veux aller chercher automatiquement dans l'onglet Données la ligne ou j'ai United Kingdom et prendre tous les chiffres de cette ligne(231 car United Kingdom est à la ligne 231 de l'onglet Données)) et les coller en ligne 3 de l'onglet Feuil2 dans les memes colonnes(les données sont toujours de la colonne L à la colonne FK
en A4 j'ai Denmark donc je veux aller chercher automatiquement les chiffres de la la ligne 81 de l'onglet Données et les coller de L4 à FK4 dans l'onglet Feuil2

Merci

http://www.cijoint.fr/cjlink.php?file=cj201103/cijSpkRgPd.xls

7 réponses

  1.
    michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    Bonjour

    Dans feuil2, on retrouve plusieurs fois le même pays - par ex UK en lignes 3,7, 18,19 etc-

    que fait-on ? report à chaque de données ligne 231 ou vide ou..... ?
    0
  2. zineb009 Messages postés 4 Date d'inscription   Statut Membre Dernière intervention  
     
    Merci pour ta réponse michel_m

    alors aux lignes 3, 7 18, 19 .... on aura exactement les memes données
    idem pour les autres pays....
    on a que 16 pays en tout(Dans Feuil2) on aura donc 16 lignes de données qui se répeteront

    Merci encore
    0
  3. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    Ok

    proposition 

    Option Explicit 

Sub reporter_donnees() 
Dim dico As Object 
Dim derlig As Integer, cptr As Integer, lig As Integer 
Dim pays As String 
Dim liste 
 'Start = Timer 'pour essais rapidité 
  
'creation d 'un dictionnaire liste des données par pays 
Set dico = CreateObject("scripting.dictionary") 
With Sheets(2) 
    derlig = Cells(.Rows.Count, 1).End(xlUp).Row 
    For cptr = 3 To derlig 
        pays = .Cells(cptr, 1) 
        If Not dico.exists(pays) Then 
            With Sheets("données") 
                lig = .Columns(1).Find(pays, .Range("A1"), xlValues).Row 
                dico.Add pays, .Range(.Cells(lig, "L"), .Cells(lig, "FK")).Value 
            End With 
        End If 
     Next 
      
'report des données par pays dans feuil2 
    Application.ScreenUpdating = False 
    For cptr = 3 To derlig
        pays = .Cells(cptr, 1)
        liste = dico.Item(pays) 
        .Range(Cells(cptr, "L"), Cells(cptr, "FK")) = liste 
    Next 
End With 
'MsgBox "temps: " & Timer - Start & " sec." 

End Sub


    environ 8/10 de seconde : un peu déçu mais je ne vois pas autrement...
    Tu dis
    Michel
    0
  4. zineb009 Messages postés 4 Date d'inscription   Statut Membre Dernière intervention  
     
    8/10 s c très bien
    Merci ca marche
    0
    1. zineb009 Messages postés 4 Date d'inscription   Statut Membre Dernière intervention  
       
      Toujours dans cette idée de fonction ou Macro Pays..
      En Feuile2 j'ai encore une liste de pays(en colonneA) avec un chiffre pour chacun en colonne B
      Et en Feuil1 J'aimerai faire comme suit:
      en L20, L21, L22 et L23 je veux avoir 5 car on a 5 en H20Feuil2 pou United Kingdom
      de L24 à L29 on a 4 car on a 4 en H69Feuil2 pour Denmark et j'aimerai donc remplir la colonne L de Feuil1 ainsi.

      mERCI ENCORE POUR TON AIDE
      0
    2. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
       
      mets le classeur en PJ sinon j'ai du mal à piger ;-)
      0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. zineb009 Messages postés 4 Date d'inscription   Statut Membre Dernière intervention  
     
    bien sur j'oubliais
    http://www.cijoint.fr/cjlink.php?file=cj201103/cijcAQwJVt.xls

    Merci
    0
  7. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    OK, je regarde demain matin à la fraiche...
    0
  8. michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 320
     
    Bonjour 

    Option Explicit

Sub affecter_no()
Dim Dico As Object
Dim Derlig As Integer, Cptr As Integer
Dim T_out, Cptr_t As Integer

Set Dico = CreateObject("scripting.dictionary")
With Sheets("feuil2")
    Derlig = .Cells(.Rows.Count, 1).End(xlUp).Row
    For Cptr = 2 To Derlig
        Dico.Add .Cells(Cptr, 1).Value, .Cells(Cptr, 8).Value
    Next
End With

Application.ScreenUpdating = False
With Sheets("feuil1")
    Derlig = .Cells(.Rows.Count, 3).End(xlUp).Row
    ReDim T_out(Range("C20:C" & Derlig).Rows.Count - 1)
    For Cptr = 20 To Derlig
        T_out(Cptr_t) = Dico.Item(.Cells(Cptr, 3).Value)
        Cptr_t = Cptr_t + 1
    Next
    .Range("L20").Resize(UBound(T_out) + 1) = Application.Transpose(T_out)
End With
       
End Sub

Tu dis...
    0