Simplification d'une macro

L

liquoreux

XLDnaute Junior
Bonjour,

J'ai une macro qui marche bien mais que je souhaiterais simplifier :

En effet, la première série transforme en majuscule chaque Nom dans plusieurs colonnes réparties à plusieurs endroits. Je souhaiterais que cette transformation soit liée au nom des colonnes et non à leur emplacement dans le tableau :

'Transforme en majuscule chaque Nom dans la colonne NOM'
Range("B1", Range("B1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Value = UCase(cell.Value)
Next cell

'Transforme en majuscule chaque Mot dans la colonne BUREAU DISTRIBUTEUR'
Range("K1", Range("K1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Value = UCase(cell.Value)
Next cell

'Transforme en majuscule chaque Mot dans la colonne CANDIDATURE SPONTANNEE'
Range("L1", Range("L1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Value = UCase(cell.Value)
Next cell

'Transforme en majuscule chaque Mot dans la colonne REPONSE A ANNONCE'
Range("Q1", Range("Q1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Value = UCase(cell.Value)
Next cell

'Transforme en majuscule chaque Mot dans la colonne SERVICE'
Range("X1", Range("X1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Value = UCase(cell.Value)
Next cell

'Transforme en majuscule chaque Mot dans la colonne REPONSE A CANDIDATURE'
Range("G1", Range("G1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Value = UCase(cell.Value)
Next cell

'Transforme en majuscule chaque Mot dans la colonne REPONSE DU SERVICE'
Range("AA1", Range("AA1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Value = UCase(cell.Value)
Next cell
Cliquez pour agrandir...


Idem pour les lignes qui transforment en majuscules la première lettre du mot :


'Transforme en majuscule la première lettre de chaque Prénom dans la colonne PRENOM'
Range("C1", Range("C1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Formula = StrConv(cell.Formula, vbProperCase)
Next cell

'Transforme en majuscule la première lettre de chaque Mot dans les colonnes ADRESSES N°1 et N°2'
Range("H1:I1", Range("H1:I1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Formula = StrConv(cell.Formula, vbProperCase)
Next cell

'Transforme en majuscule la première lettre de chaque Mot dans les colonnes POSTE DEMANDE N°1 à TOUT POSTE'
Range("M1:p1", Range("M1:p1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Formula = StrConv(cell.Formula, vbProperCase)
Next cell

'Transforme en majuscule la première lettre de chaque Mot dans les colonnes POSTE DEMANDE N°1 à TOUT POSTE'
Range("S1:T1", Range("S1:T1").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).Select
For Each cell In Selection
cell.Formula = StrConv(cell.Formula, vbProperCase)
Next cell
Cliquez pour agrandir...


Idem pour les lignes qui vérifient que les valeurs rentrées sont bien des dates et qui indiquent les erreurs en rouge avec un message d'alerte. Stoppent la procédure s'il y a des erreurs :

Colonnes :
D : Date lettre candidat
E : Date lettre attente
F : Date reponse
R : Date annonce
U : Date entretien n°1
V : Date entretien n°2
W : Date entretien n°3
Y : Date denvoi
Z : Date de retour

'vérifie que les valeurs rentrées sont bien des dates et indique les erreurs en rouge avec un message d'alerte. Stoppe la procédure s'il y a des erreurs

Range("D2:F2", Range("D2:F2").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).SpecialCells(xlCellTypeConstants).Select
For Each cell In Selection
If Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000" Then
cell.Select
cell.Font.ColorIndex = 3
cell.Interior.ColorIndex = 1
message = InputBox("Entrez un format de date (jj/mm/aaaa) en utilisant les symboles suivants :" & vbLf & " j pour jour" & vbLf & " m pour mois" & vbLf & " a pour année" & vbLf & "Exemple : " & Date)
If message = "" Then Exit Sub
cell.Value = message
cell.Font.ColorIndex = 1
cell.Interior.ColorIndex = 0
Do While Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000"
cell.Font.ColorIndex = 3
cell.Interior.ColorIndex = 1
message = InputBox("veuillez recommencer")
If message = "" Then Exit Sub
If Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000" Then
cell.Value = message
cell.Font.ColorIndex = 1
cell.Interior.ColorIndex = 0
Exit Do
End If
Loop

End If
Next

Range("R2:R2", Range("R2:R2").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).SpecialCells(xlCellTypeConstants).Select
For Each cell In Selection
If Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000" Then
cell.Select
cell.Font.ColorIndex = 3
cell.Interior.ColorIndex = 1
message = InputBox("Entrez un format de date (jj/mm/aaaa) en utilisant les symboles suivants :" & vbLf & " j pour jour" & vbLf & " m pour mois" & vbLf & " a pour année" & vbLf & "Exemple : " & Date)
If message = "" Then Exit Sub
cell.Value = message
cell.Font.ColorIndex = 1
cell.Interior.ColorIndex = 0
Do While Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000"
cell.Font.ColorIndex = 3
cell.Interior.ColorIndex = 1
message = InputBox("veuillez recommencer")
If message = "" Then Exit Sub
If Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000" Then
cell.Value = message
cell.Font.ColorIndex = 1
cell.Interior.ColorIndex = 0
Exit Do
End If
Loop

End If
Next

Range("U2:W2", Range("U2:W2").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).SpecialCells(xlCellTypeConstants).Select
For Each cell In Selection
If Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000" Then
cell.Select
cell.Font.ColorIndex = 3
cell.Interior.ColorIndex = 1
message = InputBox("Entrez un format de date (jj/mm/aaaa) en utilisant les symboles suivants :" & vbLf & " j pour jour" & vbLf & " m pour mois" & vbLf & " a pour année" & vbLf & "Exemple : " & Date)
If message = "" Then Exit Sub
cell.Value = message
cell.Font.ColorIndex = 1
cell.Interior.ColorIndex = 0
Do While Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000"
cell.Font.ColorIndex = 3
cell.Interior.ColorIndex = 1
message = InputBox("veuillez recommencer")
If message = "" Then Exit Sub
If Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000" Then
cell.Value = message
cell.Font.ColorIndex = 1
cell.Interior.ColorIndex = 0
Exit Do
End If
Loop

End If
Next

Range("Y2:Z2", Range("Y2:Z2").EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).SpecialCells(xlCellTypeConstants).Select
For Each cell In Selection
If Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000" Then
cell.Select
cell.Font.ColorIndex = 3
cell.Interior.ColorIndex = 1
message = InputBox("Entrez un format de date (jj/mm/aaaa) en utilisant les symboles suivants :" & vbLf & " j pour jour" & vbLf & " m pour mois" & vbLf & " a pour année" & vbLf & "Exemple : " & Date)
If message = "" Then Exit Sub
cell.Value = message
cell.Font.ColorIndex = 1
cell.Interior.ColorIndex = 0
Do While Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000"
cell.Font.ColorIndex = 3
cell.Interior.ColorIndex = 1
message = InputBox("veuillez recommencer")
If message = "" Then Exit Sub
If Not IsDate(cell) Or cell.NumberFormatLocal <> "jj/mm/aaaa" Or Right(cell, 4) < "2000" Then
cell.Value = message
cell.Font.ColorIndex = 1
cell.Interior.ColorIndex = 0
Exit Do
End If
Loop

End If
Next
Cliquez pour agrandir...

Merci pour votre aide
 

Pièces jointes

  • Simplication_macro.xls
    31 KB · Affichages: 42
  • Simplication_macro.xls
    31 KB · Affichages: 45
  • Simplication_macro.xls
    31 KB · Affichages: 45
Trier par date Trier par votes
pierrejean

pierrejean

XLDnaute Barbatruc
Re : Simplification d'une macro

bonjour liquoreux

Ta macro simplifiée en Module2 sous le nom de Transfert1
De plus elle te permet de mettre tes colonnes ou tu le souhaites
Seule contrainte: Conserver les titres en ligne 1 et ne pas les modifier (si modification intervenir dans la macro)

NB:Je n'ais pas tout testé , si pb ne pas hesiter à revenir
 

Pièces jointes

  • Simplication_macro.zip
    17.5 KB · Affichages: 30
Vote positif 0 Vote négatif
L

liquoreux

XLDnaute Junior
Re : Simplification d'une macro

J'ai essayé mais le contrôle des dates balaye aussi les titres, qui ne sont pas des dates, et cela pose un problème.
C'est la raison pour laquelle la macro initiale commence sur la 2ème ligne de chaque colonne concernée.
 
Vote positif 0 Vote négatif
pierrejean

pierrejean

XLDnaute Barbatruc
Re : Simplification d'une macro

Re

OK

Remplacer

Code: 
.....
Set c = Sheets("SAISIE").Rows(1).Find([COLOR=red]Liste3[/COLOR](n), LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
       Range(c,c.EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).SpecialCells(xlCellTypeConstants).Select
       For Each cell In Selection
.....

par

Code: 
....
Set c = Sheets("SAISIE").Rows(1).Find([COLOR=red]Liste3[/COLOR](n), LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then
       Range(c[COLOR=blue].Offset(1, 0[/COLOR][COLOR=blue])[/COLOR], c.[COLOR=blue]Offset(1, 0[/COLOR][COLOR=blue])[/COLOR].EntireColumn.Find(What:="*", SearchDirection:=xlPrevious)).SpecialCells(xlCellTypeConstants).Select
       For Each cell In Selection
......
 
Vote positif 0 Vote négatif

Discussions similaires

M
  • Question
XL 2010 VBA
Réponses
6
Affichages
384
Hasco
Hasco
S
  • Question
Microsoft 365 créer un macro vba
Réponses
0
Affichages
163
souhaib ad
S
V
  • Résolu(e)
XL 2021 Complétion d'un tableau automatisée
Réponses
9
Affichages
666
VincentH.DR
V
N
  • Question
XL 2021 BESOIN D'aide macro
Réponses
7
Affichages
553
Gégé-45550
Gégé-45550
J
  • Question
XL 2019 Borné une extraction par date
2
Réponses
22
Affichages
2 K
jui42
J
PHV.FSM
  • Question
XL 2016 Calculer la position sur l'écran d'une position sur la grille (XL 2003)
2
Réponses
27
Affichages
3 K
Nicos
Nicos
J
  • Question
XL 2019 Sélection d'une plage de données via .Address
Réponses
2
Affichages
447
jui42
J
Usine à gaz
  • Résolu(e)
Microsoft 365 Calendrier : Modifier Target > change R
Réponses
10
Affichages
2 K
Usine à gaz
Usine à gaz
A
  • Résolu(e)
XL 2019 Inversion date avec macro import
Réponses
14
Affichages
915
Arnaud59000
A
V
  • Question
XL 2016 [RESOLU] Traduction code VBA (code trouvé sur internet je ne comprend rien)
2
Réponses
17
Affichages
2 K
VBgalère
V

Membres actuellement en ligne

2 membres et 39 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 370
Messages
2 087 693
Membres
103 641
dernier inscrit
anouarkecita2