Macros conditionnel pbl macro

R

rak

XLDnaute Junior
Bonjour a tous


J'essaie de creer une macro réalisant les taches suivante

Taches réaliser par la macro
*
*
*
. Ouvrir fichier exel test 1, données
*
1.Effectuer un tri croissant dans la colonne AMFAB colonne G de la feuille donnée
*
2. Sélectionner les véhicules ayant une am fb superieure supérieure à 3 mois par rapport au ois de mise a jours
*
Exemple*: nous sommes le 15/11/2010 mois de novembre je sélectionne les am fab du mois
*
Copier une par une les colonnes ci jointes des véhicules sélectionnés :
*
Nu CAR*
St aff
Nu Chassis*
Mod Version*
Modele *
Bse Cpt*
Am Fab*
Am Aff
Date Aff
*
*
4. Coller ces données dans le fichier de base feuille > 3 mois
*
Afficher
en rouge les véhicules ayant une date fab supérieure de 12 mois par rapport au mois
*
en orange les véhicules ayant une date fab supérieure de 9 mois par rapport à la date
d’aujourd ‘hui
en jaune les véhicules ayant une date aff supérieure de 6 mois par rapport à la date
d’aujourd ‘hui
en vert les véhicules ayant une date aff supérieure de 3 mois par rapport à la date
d’aujourd ‘hui
*
*
Attention*: Certaines colonnes ont un nom différent

Requête Fichier de base
*
Nu CAR = Nu CAR
St aff = St aff
Nu Chassis = Nu Chassis
Mod Version = Mod Version
Modele = Famille
Bse Cpt = Bse Cpt
Am Fab = Am Fab
Am Aff = Am Aff
Date Aff = Jour Af
*
*
*
*
Nota bene*: étape annexe
*
-Retourner dans le fichier Excel test1feuille données
*
1. Sélectionner toutes les colonnes des véhicules ayant une Am fab inférieure de moins de 3 mois à partir du mois de mise a jours

Exemple*: nous somme le 15/11/2010 mois de novembre sélectionnez les mois de 08/2010 au mois actuel .
*
2. Copier ces données
*
3. Coller dans la feuille < 3 mois du fichier base


Avec votre aide une macro a été développer il s'agit de la macro tri

Cette macro est limitée en terme de donnée seule 20 données peuvent être saisie
1)J'ai essaye de modifier cette limitation mais hélas je ne suis pas arriver a le réaliser
2) la macro tri réalise un copier coller mais elle copies toutes les données alors que je souhaite réaliser un copier coller des colonnes sélectionnées suivante :

fichei test Fichier base

Nu CAR colonne a = Nu CAR colonne e
St aff colonne B = St aff COLONNE b
Nu Chassis colonne f = Nu Chassis colonne c
Mod Version colonne h = Mod Version colonne d
Modele colonne g = Famille colonne e
Bse Cpt colonne j = Bse Cpt colonne f
Am Fab colonne M = Am Fab colonne g
Am Aff colonne o = Am Aff colonne h
Date Aff colonne P = Jour Af colonne i


Voici le code vba de la macro



ublic nblignelue, tableau(300, 20)
Sub tri()
Workbooks("test1_new.xls").Activate
Sheets("Données").Activate
Range("M4").Select
nblignelue = 1
Do
If Year(CDate(ActiveCell.Value)) < Year(Date) Then
If Month(Date) > 3 Then
cell = ActiveCell.Address
colonne = GetCol(ActiveCell)
'ReDim Preserve tableau(nblignelue, 20)
adresse = "$A$" + Right(Str(colonne), Len(Str(colonne)) - 1)
Range(adresse).Select
For i = 1 To 20
tableau(nblignelue, i) = ActiveCell.Value
Selection.Offset(0, 1).Select
Next
nblignelue = nblignelue + 1
Range(cell).Select
ElseIf (CDate(ActiveCell.Value)) - Month(Date) < 9 Then
cell = ActiveCell.Address
colonne = GetCol(ActiveCell)
'ReDim Preserve tableau(nblignelue, 20)
adresse = "$A$" + Right(Str(colonne), Len(Str(colonne)) - 1)
Range(adresse).Select
For i = 1 To 20
tableau(nblignelue, i) = ActiveCell.Value
Selection.Offset(0, 1).Select
Next
nblignelue = nblignelue + 1
Range(cell).Select
End If
ElseIf Month(CDate(ActiveCell.Value)) <= (Month(Date) - 3) Then
cell = ActiveCell.Address
colonne = GetCol(ActiveCell)
'ReDim Preserve tableau(nblignelue, 20)
adresse = "$A$" + Right(Str(colonne), Len(Str(colonne)) - 1)
Range(adresse).Select
For i = 1 To 20
tableau(nblignelue, i) = ActiveCell.Value
Selection.Offset(0, 1).Select
Next
nblignelue = nblignelue + 1
Range(cell).Select
End If
Selection.Offset(1, 0).Select
Loop While ActiveCell.Value <> ""
Workbooks("base_new.xls").Activate
Sheets("> 3mois").Activate
Range("a2").Select
For i = 1 To nblignelue - 1
For j = 1 To 20
ActiveCell.Value = tableau(i, j)
Selection.Offset(0, 1).Select
Next
Selection.Offset(1, -20).Select
Next
End Sub
Sub test()
ft = MsgBox(Str(GetCol(ActiveCell)), , "TEST")
End Sub
Public Function GetCol(cell As Range) As Integer
GetCol = Val(Right(cell.Address, Len(cell.Address) - InStr(2, cell.Address, "$")))
End Function
Encore une nouvelle fois merci pour votre aide
 
Trier par date Trier par votes
Staple1600

Staple1600

XLDnaute Barbatruc
Re : Macros conditionnel pbl macro

Bonsoir


Je te conseille d'utiliser les balises CODE
Car ton message est difficile à lire.

Cela devrait te permettre d'avoir plus de réponses à ta question.

Voila le résultat affiché avec cette balise
Code: 
Public nblignelue, tableau(300, 20)
Sub tri()
Workbooks("test1_new.xls").Activate
'.... ici le reste de ta macro (que j'ai supprimé pour gain de place)
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
R

rak

XLDnaute Junior
Re : Macros conditionnel pbl macro

Bonsoir

Avec votre aide une macro a été développer il s'agit de la macro tri

Cette macro est limitée en terme de donnée seule 20 données peuvent être saisie
1)J'ai essaye de modifier cette limitation mais hélas je ne suis pas arriver a le réaliser
2) la macro tri réalise un copier coller mais elle copies toutes les données alors que je souhaite réaliser un copier coller des colonnes sélectionnées suivante :

fichei test Fichier base

Nu CAR colonne a = Nu CAR colonne e
St aff colonne B = St aff COLONNE b
Nu Chassis colonne f = Nu Chassis colonne c
Mod Version colonne h = Mod Version colonne d
Modele colonne g = Famille colonne e
Bse Cpt colonne j = Bse Cpt colonne f
Am Fab colonne M = Am Fab colonne g
Am Aff colonne o = Am Aff colonne h
Date Aff colonne P = Jour Af colonne i


Voici le code vba de la macro



Code: 
Public nblignelue, tableau(300, 20)
Sub tri()
Workbooks("test1_new.xls").Activate
Sheets("Données").Activate
Range("M4").Select
nblignelue = 1
Do
If Year(CDate(ActiveCell.Value)) < Year(Date) Then
If Month(Date) > 3 Then
cell = ActiveCell.Address
colonne = GetCol(ActiveCell)
'ReDim Preserve tableau(nblignelue, 20)
adresse = "$A$" + Right(Str(colonne), Len(Str(colonne)) - 1)
Range(adresse).Select
For i = 1 To 20
tableau(nblignelue, i) = ActiveCell.Value
Selection.Offset(0, 1).Select
Next
nblignelue = nblignelue + 1
Range(cell).Select
ElseIf (CDate(ActiveCell.Value)) - Month(Date) < 9 Then
cell = ActiveCell.Address
colonne = GetCol(ActiveCell)
'ReDim Preserve tableau(nblignelue, 20)
adresse = "$A$" + Right(Str(colonne), Len(Str(colonne)) - 1)
Range(adresse).Select
For i = 1 To 20
tableau(nblignelue, i) = ActiveCell.Value
Selection.Offset(0, 1).Select
Next
nblignelue = nblignelue + 1
Range(cell).Select
End If
ElseIf Month(CDate(ActiveCell.Value)) <= (Month(Date) - 3) Then
cell = ActiveCell.Address
colonne = GetCol(ActiveCell)
'ReDim Preserve tableau(nblignelue, 20)
adresse = "$A$" + Right(Str(colonne), Len(Str(colonne)) - 1)
Range(adresse).Select
For i = 1 To 20
tableau(nblignelue, i) = ActiveCell.Value
Selection.Offset(0, 1).Select
Next
nblignelue = nblignelue + 1
Range(cell).Select
End If
Selection.Offset(1, 0).Select
Loop While ActiveCell.Value <> ""
Workbooks("base_new.xls").Activate
Sheets("> 3mois").Activate
Range("a2").Select
For i = 1 To nblignelue - 1
For j = 1 To 20
ActiveCell.Value = tableau(i, j)
Selection.Offset(0, 1).Select
Next
Selection.Offset(1, -20).Select
Next
End Sub
Sub test()
ft = MsgBox(Str(GetCol(ActiveCell)), , "TEST")
End Sub
Public Function GetCol(cell As Range) As Integer
GetCol = Val(Right(cell.Address, Len(cell.Address) - InStr(2, cell.Address, "$")))
End Function
 
Vote positif 0 Vote négatif
R

rak

XLDnaute Junior
Re : Macros conditionnel pbl macro

Code: 
Public nblignelue, tableau(300, 20)
Sub tri()
Workbooks("test1_new.xls").Activate
Sheets("Données").Activate
Range("M4").Select
nblignelue = 1
Do
If Year(CDate(ActiveCell.Value)) < Year(Date) Then
If Month(Date) > 3 Then
cell = ActiveCell.Address
colonne = GetCol(ActiveCell)
'ReDim Preserve tableau(nblignelue, 20)
adresse = "$A$" + Right(Str(colonne), Len(Str(colonne)) - 1)
Range(adresse).Select
For i = 1 To 20
tableau(nblignelue, i) = ActiveCell.Value
Selection.Offset(0, 1).Select
Next
nblignelue = nblignelue + 1
Range(cell).Select
ElseIf (CDate(ActiveCell.Value)) - Month(Date) < 9 Then
cell = ActiveCell.Address
colonne = GetCol(ActiveCell)
'ReDim Preserve tableau(nblignelue, 20)
adresse = "$A$" + Right(Str(colonne), Len(Str(colonne)) - 1)
Range(adresse).Select
For i = 1 To 20
tableau(nblignelue, i) = ActiveCell.Value
Selection.Offset(0, 1).Select
Next
nblignelue = nblignelue + 1
Range(cell).Select
End If
ElseIf Month(CDate(ActiveCell.Value)) <= (Month(Date) - 3) Then
cell = ActiveCell.Address
colonne = GetCol(ActiveCell)
'ReDim Preserve tableau(nblignelue, 20)
adresse = "$A$" + Right(Str(colonne), Len(Str(colonne)) - 1)
Range(adresse).Select
For i = 1 To 20
tableau(nblignelue, i) = ActiveCell.Value
Selection.Offset(0, 1).Select
Next
nblignelue = nblignelue + 1
Range(cell).Select
End If
Selection.Offset(1, 0).Select
Loop While ActiveCell.Value <> ""
Workbooks("base_new.xls").Activate
Sheets("> 3mois").Activate
Range("a2").Select
For i = 1 To nblignelue - 1
For j = 1 To 20
ActiveCell.Value = tableau(i, j)
Selection.Offset(0, 1).Select
Next
Selection.Offset(1, -20).Select
Next
End Sub
Sub test()
ft = MsgBox(Str(GetCol(ActiveCell)), , "TEST")
End Sub
Public Function GetCol(cell As Range) As Integer
GetCol = Val(Right(cell.Address, Len(cell.Address) - InStr(2, cell.Address, "$")))
 
Vote positif 0 Vote négatif

Discussions similaires

L
  • Résolu(e)
XL 2013 RECUPARATION FICHIER PDF
Réponses
2
Affichages
736
laurentsicli
L
M
  • Résolu(e)
XL 2016 Message d'erreur aléatoire pour les utilisateurs réseau -Excel 2016
Réponses
11
Affichages
2 K
Melidan2006
M
S
  • Question
[Résolu]Problème Macro Export (ne fonctionne plus)
Réponses
4
Affichages
2 K
sebm1976
S
O
  • Question
Problème avec macro qui ne fonctionne plus
Réponses
2
Affichages
689
OOLIVE
O
R
  • Question
pb macro
Réponses
2
Affichages
767
Paritec
Paritec
R
  • Question
Augmenter liste de lecture de la macro
Réponses
0
Affichages
698
rak
R
M
  • Question
faire évoluer code userform choix
Réponses
3
Affichages
1 K
MarcTer
M
N
  • Question
Booster une macro
Réponses
5
Affichages
3 K
Staple1600
Staple1600
J
  • Question
Pourquoi ma macro ne marche pas quand je l'éxécute en une macro !
Réponses
7
Affichages
2 K
gilbert_RGI
gilbert_RGI
treza88
  • Question
Plantage excel sur fermeture classeur
2
Réponses
16
Affichages
4 K
treza88
treza88

Membres actuellement en ligne

14 membres et 137 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 242
Messages
2 086 536
Membres
103 244
dernier inscrit
lavitzdecreu