MacroOUfonction

zineb009 Messages postés 5 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

michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
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
zineb009 Messages postés 5 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
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
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
zineb009 Messages postés 5 Date d'inscription   Statut Membre Dernière intervention  
 
8/10 s c très bien
Merci ca marche
0
zineb009 Messages postés 5 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
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
mets le classeur en PJ sinon j'ai du mal à piger ;-)
0

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

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

Merci
0
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
OK, je regarde demain matin à la fraiche...
0
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
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