A voir également:
- Une macro par mois
- Telecharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Jitbit macro recorder - Télécharger - Confidentialité
- Trier par mois excel - Guide
- Télécharger macro convertir chiffre en lettre excel - Télécharger - Tableur
- Youtube premium 2 mois gratuit - Accueil - TV & Vidéo
3 réponses
Bonjour,
C'est probablement possible, mais avec aussi peu d'informations, on ne peut guère te répondre précisément...
m@rina
C'est probablement possible, mais avec aussi peu d'informations, on ne peut guère te répondre précisément...
m@rina
Sub Enregistrement()
Dim balise As Boolean
Dim nbre As Integer, nbre2 As Integer, j As Integer, K As Integer, reponse As Integer
Dim wsEDM As Worksheet, wsSF As Worksheet, wsDM As Worksheet, wsLF As Worksheet, wsEM As Worksheet
Dim liste As Range
Dim valeur As Variant
Set wsEM = Workbooks("Enregistrement du mois").Worksheets("feuil2")
Set wsSF = Workbooks("Liste fournisseurs_test mdb").Worksheets("Feuil2")
Set wsEDM = ThisWorkbook.Worksheets("Enregistrement_du_mois")
Set wsDM = ThisWorkbook.Worksheets("Dernier Mois")
Set wsLF = ThisWorkbook.Worksheets("Liste fournisseur")
wsEDM.Cells.ClearContents
wsDM.Activate
Cells.Select
Range("K1").Activate
Selection.Copy
wsEDM.Activate
Range("A1").Select
ActiveSheet.Paste
'nbre = wsF.Cells(Rows.Count, 2).End(xlUp).Row - 1
'nbre2 = wsSF.Cells(Rows.Count, 1).End(xlUp).Row - 1
'
'For i = 1 To nbre2
' balise = False
' For j = 1 To nbre
' If wsSF.Cells(i + 1, 1).Value = wsF.Cells(j + 1, 2).Value Then balise = True
' Next j
'Next i
Application.ScreenUpdating = False
'Calcul du nombre de fournisseurs
nbre = wsLF.Cells(Rows.Count, 2).End(xlUp).Row - 1
Set liste = wsLF.Cells(2, 2).Resize(nbre, 3)
'Création du nom de la plage de cellule des fournisseurs
ThisWorkbook.Names.Add Name:="liste", RefersToR1C1:=liste
'Calcul du nombre de cadence du mois
nbre = wsEDM.Cells(Rows.Count, 1).End(xlUp).Row - 1
'''''Filtre fournisseurs'''''
'Calcul intermédiaire des valeurs de RechercheV
wsEDM.Cells(2, 17).Resize(nbre, 1).FormulaR1C1 = "=VLOOKUP(RC[-15],liste,1,0)"
'Tri des cadences en fonction du résultat de la RechercheV
wsEDM.Cells(2, 1).Resize(nbre, 17).Sort Key1:=Range("Q2"), Order1:=xlAscending
'Calcul du nombre de fournisseurs hors contexte
nbre2 = WorksheetFunction.CountIf(wsEDM.Cells(2, 17).Resize(nbre, 1), "=#N/A")
'Suppression des cadences hors contexte
wsEDM.Cells(nbre - nbre2 + 2, 1).Resize(nbre2, 19).Delete Shift:=xlUp
'Suppression de la colonne des RechercheV
wsEDM.Columns(17).Delete
'stockage du nombre de cadence dans la variable nbre
nbre = nbre2
'Création de la colonne "Code Unique" et concaténation des codes
wsEDM.Columns(17).Insert Shift:=xlToRight
wsEDM.Cells(1, 17).Value = "Code Unique"
Range("Q2").Select
ActiveCell.FormulaR1C1 = "=CONCATENER(D2;E2;F2)"
Range("Q2").Select
Selection.NumberFormat = "General"
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-13],RC[-12],RC[-11])"
Columns("Q:Q").Select
Selection.NumberFormat = "General"
Range("Q2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-13],RC[-12],RC[-11])"
Range("Q2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=-6
'tri des données par ordre décroissant de date de réception
wsEDM.Cells(2, 1).Resize(nbre, 17).Sort Key1:=Range("Q2"), Order1:=xlDescending
'Calcul intermédiaire des valeurs de RechercheV
wsEDM.Cells(2, 18).Resize(nbre, 1).FormulaR1C1 = "=VLOOKUP(RC[-16],liste,3,0)"
wsEDM.Cells(2, 19).Resize(nbre, 1).FormulaR1C1 = "month(RC[-11])"
'Tri des cadences en fonction du résultat de la RechercheV
wsEDM.Cells(2, 1).Resize(nbre, 18).Sort Key1:=Range("R2"), Order1:=xlAscending
'Suppression des cadences hors contexte
nbre2 = WorksheetFunction.CountIf(wsEDM.Cells(2, 18).Resize(nbre, 1), "=#N/A")
wsEDM.Cells(nbre - nbre2 + 2, 1).Resize(nbre, 19).Delete Shift:=xlUp
End Sub
Ce code tourne une fois par mois donc le 1er jour qu'il sera lancé sera le 03/06, la seconde fois est le mois d'aprés et ainsi de suite
Dim balise As Boolean
Dim nbre As Integer, nbre2 As Integer, j As Integer, K As Integer, reponse As Integer
Dim wsEDM As Worksheet, wsSF As Worksheet, wsDM As Worksheet, wsLF As Worksheet, wsEM As Worksheet
Dim liste As Range
Dim valeur As Variant
Set wsEM = Workbooks("Enregistrement du mois").Worksheets("feuil2")
Set wsSF = Workbooks("Liste fournisseurs_test mdb").Worksheets("Feuil2")
Set wsEDM = ThisWorkbook.Worksheets("Enregistrement_du_mois")
Set wsDM = ThisWorkbook.Worksheets("Dernier Mois")
Set wsLF = ThisWorkbook.Worksheets("Liste fournisseur")
wsEDM.Cells.ClearContents
wsDM.Activate
Cells.Select
Range("K1").Activate
Selection.Copy
wsEDM.Activate
Range("A1").Select
ActiveSheet.Paste
'nbre = wsF.Cells(Rows.Count, 2).End(xlUp).Row - 1
'nbre2 = wsSF.Cells(Rows.Count, 1).End(xlUp).Row - 1
'
'For i = 1 To nbre2
' balise = False
' For j = 1 To nbre
' If wsSF.Cells(i + 1, 1).Value = wsF.Cells(j + 1, 2).Value Then balise = True
' Next j
'Next i
Application.ScreenUpdating = False
'Calcul du nombre de fournisseurs
nbre = wsLF.Cells(Rows.Count, 2).End(xlUp).Row - 1
Set liste = wsLF.Cells(2, 2).Resize(nbre, 3)
'Création du nom de la plage de cellule des fournisseurs
ThisWorkbook.Names.Add Name:="liste", RefersToR1C1:=liste
'Calcul du nombre de cadence du mois
nbre = wsEDM.Cells(Rows.Count, 1).End(xlUp).Row - 1
'''''Filtre fournisseurs'''''
'Calcul intermédiaire des valeurs de RechercheV
wsEDM.Cells(2, 17).Resize(nbre, 1).FormulaR1C1 = "=VLOOKUP(RC[-15],liste,1,0)"
'Tri des cadences en fonction du résultat de la RechercheV
wsEDM.Cells(2, 1).Resize(nbre, 17).Sort Key1:=Range("Q2"), Order1:=xlAscending
'Calcul du nombre de fournisseurs hors contexte
nbre2 = WorksheetFunction.CountIf(wsEDM.Cells(2, 17).Resize(nbre, 1), "=#N/A")
'Suppression des cadences hors contexte
wsEDM.Cells(nbre - nbre2 + 2, 1).Resize(nbre2, 19).Delete Shift:=xlUp
'Suppression de la colonne des RechercheV
wsEDM.Columns(17).Delete
'stockage du nombre de cadence dans la variable nbre
nbre = nbre2
'Création de la colonne "Code Unique" et concaténation des codes
wsEDM.Columns(17).Insert Shift:=xlToRight
wsEDM.Cells(1, 17).Value = "Code Unique"
Range("Q2").Select
ActiveCell.FormulaR1C1 = "=CONCATENER(D2;E2;F2)"
Range("Q2").Select
Selection.NumberFormat = "General"
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-13],RC[-12],RC[-11])"
Columns("Q:Q").Select
Selection.NumberFormat = "General"
Range("Q2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-13],RC[-12],RC[-11])"
Range("Q2").Select
Selection.Copy
Range(Selection, Selection.End(xlDown)).Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=-6
'tri des données par ordre décroissant de date de réception
wsEDM.Cells(2, 1).Resize(nbre, 17).Sort Key1:=Range("Q2"), Order1:=xlDescending
'Calcul intermédiaire des valeurs de RechercheV
wsEDM.Cells(2, 18).Resize(nbre, 1).FormulaR1C1 = "=VLOOKUP(RC[-16],liste,3,0)"
wsEDM.Cells(2, 19).Resize(nbre, 1).FormulaR1C1 = "month(RC[-11])"
'Tri des cadences en fonction du résultat de la RechercheV
wsEDM.Cells(2, 1).Resize(nbre, 18).Sort Key1:=Range("R2"), Order1:=xlAscending
'Suppression des cadences hors contexte
nbre2 = WorksheetFunction.CountIf(wsEDM.Cells(2, 18).Resize(nbre, 1), "=#N/A")
wsEDM.Cells(nbre - nbre2 + 2, 1).Resize(nbre, 19).Delete Shift:=xlUp
End Sub
Ce code tourne une fois par mois donc le 1er jour qu'il sera lancé sera le 03/06, la seconde fois est le mois d'aprés et ainsi de suite