Simplification d'une macro

liquoreux · 5 Novembre 2009

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

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😛1", Range("M1😛1").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

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

Merci pour votre aide

pierrejean · 5 Novembre 2009

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

liquoreux · 5 Novembre 2009

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.

pierrejean · 5 Novembre 2009

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
......

liquoreux · 5 Novembre 2009

Re : Simplification d'une macro

Cela fonctionne parfaitement.

Merci beaucoup pour votre aide précieuse.

Simplification d'une macro

liquoreux

XLDnaute Junior

Pièces jointes

pierrejean

XLDnaute Barbatruc

Pièces jointes

liquoreux

XLDnaute Junior

pierrejean

XLDnaute Barbatruc

liquoreux

XLDnaute Junior

Discussions similaires

Simplification d'une macro

liquoreux

XLDnaute Junior

Pièces jointes

pierrejean

XLDnaute Barbatruc

Pièces jointes

liquoreux

XLDnaute Junior

pierrejean

XLDnaute Barbatruc

liquoreux

XLDnaute Junior

Discussions similaires

Privacy & Transparency

Privacy & Transparency