Macro récupération données par rapport à la date Résolu/Fermé

Question

Bonjour, 

Dans la feuille 1,  j'ai en colonne A les salariés, en colonne B les CA Réalisées le 25/10/2012, en colonne C CA réalisées le 05112012

	       25102012	5112012
Henri	4 000	3800
Jacques	3 300	3350
Amandine	1546	1400
Léa	        1369	1600
Anouchka	2100	1802
Pierre	1364	1652
Jean	        1478	1652
Paul	        3254	2800
Patrick	1968	1960

En feuille 2, je voudrais que si une des dates de la feuille n'apparaît de créer une colonne centrale avec les CA réalisées, puis à gauche les objectifs et à droite la différence, et une fusion de la ligne des 3 nouvelles colonnes pour mettre la date. :
	               29102012		
	       object	réalisés	diff
Henri	3500	4 000	500
Jacques	3500	3 300	-200
Amandine	1500	1546	46
Léa	        1500	1369	-131
Anouchka	2000	2100	100
Pierre	1500	1364	-136
Jean	        1500	1478	-22
Paul	        2000	3254	1 254
Patrick	1500	1968	468


merci pour votre aide.

Sam

G_33 · Answer

Bonjour

Un peu confus votre demande surtout la partie qui concerne la feuille 2

Vous pouvez preciser?

sam · Answer

coment puis-je déposer le document ce sera plus clair ?

cdlt

sam

sam · Answer

bonjour,

voici le document :
http://cjoint.com/confirm.php?cjoint=0KtpETxOBJj

Cdlt.

sam

sam · Answer

1) prendre en compte des dates sur 'feuil1' en ligne 2
2) vérifier si la date existe dans 'feuil2' 
     si oui : ne rien faire
     si non : - ajout de la date en ligne 2 à partir de la dernière colonne non vide (en fusionnant la celulle sur  colonnes)
                  - copier les valeurs sui se trouvaient sous la date en feuil1 dans la colonne du milieu
                  - sur la colonne de gauche en ligne 3 écrire 'object' et copier les anciennes valeurs d'objet de 3 colonnes sur la gauche
                  - sur la colonne de droite en ligne écrire 'diff' et mettre la formule '=MAX(B5-C5;0)'

sam44 · Answer

Voici le début

Sub MaMacrro1()
'
' MaMacro1 
'
'
' compare date, si présente des 2 côtés, ne rien faire
    Dim datc As Date
    Dim datr As Date

    Dim str  As String
    
    Sheets("Feuil2").Select
    str = ActiveSheet.Range("B1").Value
    datc = str
    'MsgBox datc, 15
    

    
    Dim str2 As String
    Sheets("Feuil1").Select
    str2 = ActiveSheet.Range("C3").Value
    datr = str2
    'MsgBox datr, 15
    
    
    Dim dernlign As Integer
    
    Dim intersect As String
    
    
    If datr = datc Then
          ' do something
        MsgBox "identique", 15 ' continue
        
        Else
        
        ...
        
    Sheets("Capacity").Select
    Range("B3:& $intersec ").Select
    Selection.NumberFormat = "#,##0.00"
        
        
    End If

    
End Sub

sam44 · Answer

avec l'aide d'un collègue modification de la macro :
Dim val_date(50), test As String
Dim compteur_date, i, l, c, m As Integer
Dim trouver As Boolean

compteur_date = 1

Sheets("Feuil2").Select
For i = 2 To DernColonne2
test = Cells(1, i).Value
 If Cells(1, i).Value <> "" Then
    val_date(compteur_date) = Cells(1, i).Value
    compteur_date = compteur_date + 1
    End If
Next

Worksheets("Feuil1").Select

For c = 3 To DernColonne1
    trouver = False
    For i = 1 To compteur_date - 1
        trouver = Cells(3, c).Value = val_date(i)
        If Not trouver Then
        Worksheets("Feuil2").Cells(1, DernColonne2 + 2).Value = Worksheets("Feuil1").Cells(3, c).Value
            For m = 3 To DernLigne1
            Worksheets("Feuil2").Cells(m, DernColonne2 + 2).Value = Worksheets("Feuil1").Cells((m + 1), c).Value
            Next
            Worksheets("Feuil2").Cells(2, DernColonne2 + 2).Value = "Used"
            Worksheets("Feuil2").Select
            Range("B2:B14").Select
            Selection.Copy
            Range(Worksheets("Feuil2").Cells(2, DernColonne2 + 1).Address).PasteSpecial xlPasteAll
            Range("D2:D14").Select
            Selection.Copy
            Range(Worksheets("Feuil2").Cells(2, DernColonne2 + 3).Address).PasteSpecial xlPasteFormulas
        trouver = False
        
            
       DernColonne2 = Range("B3").End(xlToRight)(1, 2).Column - 1
        
        Else: Exit For
        
        
        
        End If
        
    Next


--> le seul hic c'est qu'il reproduit systématique ment les colonnes déjà en place sur Feuil2, je pense faire un 'for each' mais je ne sais comme l'introduire dans cette macro

eriiic · Answer

Bonjour,

Pour simplifier la macro et comme tu ne le précisais pas  j'ai considéré que :
1) les noms étaient toujours les même et dans le même ordre.
2) les 1ère données en B4:D12 étaient saisies, formule y compris

Par ailleurs étant un farouche adversaire des fusions de cellule qui sont des nids à emm...ments je les ai enlevées.

https://www.cjoint.com/?BKBrafh3YZM

eric

sam44 · Answer

Merci eriiic ça fonctionne parfaitement.

Cordialement.

Sam

Macro récupération données par rapport à la date

8 réponses

Discussions similaires