Macro récupération données par rapport à la date
Résolu/Fermé
A voir également:
- Macro récupération données par rapport à la date
- Macro word - Guide
- Macro logiciel - Télécharger - Organisation
- Logiciel de récupération de données - Guide
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Macro recorder - Télécharger - Confidentialité
8 réponses
Bonjour
Un peu confus votre demande surtout la partie qui concerne la feuille 2
Vous pouvez preciser?
Un peu confus votre demande surtout la partie qui concerne la feuille 2
Vous pouvez preciser?
coment puis-je déposer le document ce sera plus clair ?
cdlt
sam
cdlt
sam
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)'
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)'
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
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
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
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
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
Messages postés
24569
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
28 décembre 2023
7 209
27 nov. 2012 à 17:01
27 nov. 2012 à 17:01
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
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
