Aide pour macro Excel 2007

Le 13/10/2008 à 09:26

Bonjour j’aimerai réaliser une macro qui me permet de trier les éléments Excel, j’ai copié un exemple de ce qu’elle doit réaliser, elle doit me mettre les gens qui ont leur date d’anniversaire 08/10/2008 (jours et mois) en vérifiant que leurs ADDR soit un 06 (pour leur envoyer un sms)

Donc elle doit trier en tenant compte de la date de naissance et du téléphone.

Et si possible éliminer les espaces XX XX entre les téléphones.

Quelqu’un as t’il une idée ou déjà fait une macro de ce type ?

la forme du fichier excel est en bas

Merci d’avance

REF TYPE ADDR AGE

BALAARD DDD 02 40 xx xxxx 12/03/1975

LEBND DDD 08/10/1956

TOANC DDD 06112xxxxx 08/10/1978

MET DDD 06 70 xx xx xx 08/10/1978

COIER DDD 06 40 xx xx xx 05/03/1986

Le 13/10/2008 à 13:08

Bonjour,

Il est plus facile pour tous d'utiliser la fonction joindre un fichier du forum, que de s'emm... à le simuler en texte...

Pour ton fichier, essaye avec un code de ce style, en remplaçant le msgbox par ta procédure d'envoi de SMS (ça j'ai jamais fait)

Sub anniversaires()
Dim cel As Range
Dim derlig As Integer
derlig = Range("A65536").End(xlUp).Row
Dim texte As String

For Each cel In Range("D2:D" & derlig)
If Left(cel, 5) = Left(Date, 5) And Left(cel.Offset(0, -1), 2) = "06" Then
texte = cel.Offset(0, -1)
texte = Replace(texte, " ", "")
MsgBox ("C'est l'anniversaire de " & cel.Offset(0, -3) & " ! Envoyer un SMS au " & texte)
End If
Next cel

End Sub

Le 13/10/2008 à 13:45

voila l'adresse de mon fichier

https://www.excel-pratique.com/~files/doc/ZEzN1exemple.xls

et voila les macros que j'ai deja fait

Sub nom_col()
'
' nom_col Macro
' donne des noms au colonnes
'

'
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "REF"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "TYPE"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "ADDR"
    Range("E4").Select
End Sub
Sub pra_ddd()
'
' pra_ddd Macro
' Remplace Pra par ddd
'
' Touche de raccourci du clavier: Ctrl+p
'
    Columns("B:B").Select
    Selection.Replace What:="PRA", Replacement:="DDD", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False
End Sub
Sub del_lig1()
'
' del_lig1 Macro
'

'
    Rows("1:1").Select
    Selection.ClearContents
End Sub

Sub del_telfix()
'
' del_telfix Macro
'

'
    Columns("C:C").Select
    Selection.AutoFilter
    ActiveSheet.Range("$C$1:$C$297").AutoFilter Field:=1, Criteria1:="=06*", _
        Operator:=xlAnd
End Sub

Sub change_formD()
'
' change_formD Macro
'

'
    Columns("D:D").Select
    Selection.NumberFormat = "d/m;@"
End Sub

Sub gere_date()
'
' Gere date Macro
'

'
    Columns("D:D").Select
    Selection.NumberFormat = "d/m;@"
    Selection.AutoFilter
    Selection.AutoFilter
    ActiveSheet.Range("$D$1:$D$297").AutoFilter Field:=1, Criteria1:="=31/3", _
        Operator:=xlAnd
End Sub

Sub deplacement_f()
'
' deplacement_f Macro
'

'
    Range("A1:C336").Select
    ActiveWindow.SmallScroll Down:=-27
    Application.CutCopyMode = False
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste
End Sub

mais enfaite il faudrait que l'utilisateur puisse saisir lui meme la date d'anniversaire donc je pense plus a une comparaison entre deux cellules pour la macro"gere_date"

Le 13/10/2008 à 18:01

Re,

Je comprends pas tout là...

Tu veux que la macro envoie des SMS, ou qu'elle te signale de le faire

As-tu essayé mon code ?

Pour chaque personne dont l'anniversaire est la date du jour ("Left(Date, 5)" dans la macro), et dont le téléphone est un portable, tu auras un message d'avertissement.

A la place de ce message, je pensais que tu voudrais faire envoyer un SMS par ton ordinateur

Le 14/10/2008 à 09:28

lol je viens d'ecrire un long message et il c'est pas enregistrer!!!

donc je disais enfaite le but de tout ca , enfaite je suis en stage,e t dans ma boite il ont un logiciel d'envois sms , qui prends une lsite csv(excel)

et enfaite c'est des secretaires qui devront l'utiliser donc c'est pour cela je fais des macro boutons et elle ont plus qu'a cliqué .

j'ai presque fini je t'enverai la macro finale tu veras en quoi ca consiste.

par contre il me reste un dernier prob a resoudre

enfaite certaines personne rentrent dans la base de donné les tel sous 3formes

06 40 ou 06-40 ou 06.40 comment faire pour viré les espace les tirets et les points d'une colonne?

merci beaucoup

Le 14/10/2008 à 11:02

Bonjour,

Utilise la fonction Ctrl + H (Rechercher-remplacer)

Recherche les espaces et remplace par rien.

Fais de même avec les tirets et les points.

Utilise l'enregistreur de macro et regarde ce que ça donne :

Columns("A:A").Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

Pour la liste si je comprends bien tu voudrais que toutes les personnes correspondant à la date et au tél soient relistées sur une autre feuille par exemple, que tu exporteras en .csv ?

1budget-test14-12-2014.xlsm (151.09 Ko)

Le 14/10/2008 à 15:46

voila j'ai enfin finis enfaite ,

a la base c'est un logiciel comptable qui sort la liste des travailleurs exemple.xls , et apres les secretaires doivent recuperer un fichier csv pour l'introduire dans un autre logiciel qui lui envoit les sms.

il demande obligatoirement 3champ REF,TYPE et ADDR ,

le souci c'est que certaines secretairessaisissant mal les numero au debut soit avec des espaces ou des point des tirets etc , donc il faut voir que le numero est bien saisi.

c'est pour cela j'ai fais les macro pour retravaillé le fichier .

voila je joins le fichier de depart le fichier de fin et la macro que 'j'ai fait.

https://www.excel-pratique.com/~files/doc/UUgovexemple.xls debut

https://www.excel-pratique.com/~files/doc/anniversaire.csv fin

   
Sub Anniversaire()
'
' del_lig1 Macro
'

'
    Rows("1:1").Select
    Selection.ClearContents
'
' nom_col Macro
' donne des noms au colonnes
'

'
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "REF"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "TYPE"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "ADDR"
    Range("E4").Select
'
' pra_ddd Macro
' Remplace Pra par ddd
'
' Touche de raccourci du clavier: Ctrl+p
'
    Columns("B:B").Select
    Selection.Replace What:="PRA", Replacement:="DDD", LookAt:=xlPart, _
        SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat:=False, _
        ReplaceFormat:=False

    'Sub copie_jjmm() & coppy e vers f

'
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=TEXT(RC[-1],""jj/mm"")"
    Selection.AutoFill Destination:=Range("E2:E10000"), Type:=xlFillDefault
    Range("E2:E10000").Select

'
    Columns("E:E").Select
    Selection.Copy
    Columns("F:F").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

'Sub AfficheCritere()

Columns("F:F").Select 'séléction de la colonne où se trouve le critère
Selection.AutoFilter ' met en place les filtres automatique
Critère = InputBox("Date d'anniversaire ", "Date d'anniversaire jour/mois") ' Saisie du critère à rechercher
Selection.AutoFilter Field:=1, Criteria1:=Critère ' affichage du critère cherché

'Selection.AutoFilter Field:=1 ' retour à l'affichage complet de la colonne
' enlever le petit ' pour que la ligne soit opérationnelle

'
' deplacement_f Macro
'

'
    Range("A1:C10000").Select
    ActiveWindow.SmallScroll Down:=-27
    Application.CutCopyMode = False
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste

' del_f1 Macro
'

'
    Sheets("A").Select
    ActiveWindow.SelectedSheets.Delete

'
' del_telfix Macro
'

'
    Columns("C:C").Select
    Selection.AutoFilter
    ActiveSheet.Range("$C$1:$C$10000").AutoFilter Field:=1, Criteria1:="=06*", _
        Operator:=xlAnd

'  deplacement2_f  macro
'

'
    Range("A1:C10000").Select
    ActiveWindow.SmallScroll Down:=-27
    Application.CutCopyMode = False
    Selection.Copy
    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Paste

'
' change_tel_fin Macro
'

'
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D1").Select
    Selection.Cut
    Range("C1").Select
    ActiveSheet.Paste
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=SUBSTITUTE(RC[1],""."","""")"

' copie_bontel Macro
'

'
    Selection.AutoFill Destination:=Range("C2:C38"), Type:=xlFillDefault
    Range("C2:C1000").Select
    Range("C1000").Select
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 12
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 10
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 7
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 2
    ActiveWindow.ScrollRow = 1
    Range("A2").Select

' change_tel_fin Macro
'

'
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D1").Select
    Selection.Cut
    Range("C1").Select
    ActiveSheet.Paste
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=SUBSTITUTE(RC[1],""-"","""")"

' copie_bontel Macro
'

'
    Selection.AutoFill Destination:=Range("C2:C1000"), Type:=xlFillDefault
    Range("C2:C1000").Select
    Range("C1000").Select
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 12
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 10
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 7
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 2
    ActiveWindow.ScrollRow = 1
    Range("A2").Select

' change_tel_fin Macro
'

'
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D1").Select
    Selection.Cut
    Range("C1").Select
    ActiveSheet.Paste
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=SUBSTITUTE(RC[1],""/"","""")"

' copie_bontel Macro
'

'
    Selection.AutoFill Destination:=Range("C2:C1000"), Type:=xlFillDefault
    Range("C2:C1000").Select
    Range("C1000").Select
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 12
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 10
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 7
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 2
    ActiveWindow.ScrollRow = 1
    Range("A2").Select

' change_tel_fin Macro
'

'
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D1").Select
    Selection.Cut
    Range("C1").Select
    ActiveSheet.Paste
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=SUBSTITUTE(RC[1],"" "","""")"

' copie_bontel Macro
'

'
    Selection.AutoFill Destination:=Range("C2:C1000"), Type:=xlFillDefault
    Range("C2:C1000").Select
    Range("C1000").Select
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 12
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 10
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 7
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 2
    ActiveWindow.ScrollRow = 1
    Range("A2").Select

' change_tel_fin Macro
'

'
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D1").Select
    Selection.Cut
    Range("C1").Select
    ActiveSheet.Paste
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=SUBSTITUTE(RC[1],""\"","""")"

' copie_bontel Macro
'

'
    Selection.AutoFill Destination:=Range("C2:C1000"), Type:=xlFillDefault
    Range("C2:C1000").Select
    Range("C1000").Select
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 12
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 10
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 7
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 2
    ActiveWindow.ScrollRow = 1
    Range("A2").Select

' change_tel_fin Macro
'

'
    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("D1").Select
    Selection.Cut
    Range("C1").Select
    ActiveSheet.Paste
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=SUBSTITUTE(RC[1],"","","""")"

' copie_bontel Macro
'

'
    Selection.AutoFill Destination:=Range("C2:C1000"), Type:=xlFillDefault
    Range("C2:C1000").Select
    Range("C1000").Select
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 12
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 10
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 7
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 2
    ActiveWindow.ScrollRow = 1
    Range("A2").Select

' enregistrement Macro
'

'
    ChDir "C:\"
    ActiveWorkbook.SaveAs Filename:= _
        "C:\anniversaire.csv", FileFormat:=xlCSV, _
        CreateBackup:=False
End Sub

Merci pour toute l'aide

Le 14/10/2008 à 22:46

Re,

C'est quand même bien la pagaille dans ton code...

Je te l'ai un peu amélioré, en considérant que tu n'enregistre pas le fichier "exemple.xls", je sais pas si j'ai bien compris votre façon de fonctionner...

Enfin voilà un code que tu peux tester, ça ne coûte rien...

On supprime toutes les lignes pour lesquelles les 2 conditions ne sont pas remplies ("06" et date)
On remet en forme le N° de tél pour les lignes bonnes
on enregistre le fichier "anniversaire.csv" à ta manière

Le code :

Sub csv()
Dim derlig As Integer, i As Integer
derlig = Range("A65536").End(xlUp).Row
Dim texte As String
Dim dat As String
Dim critere As String
critere = InputBox("Date d'anniversaire ", "Date d'anniversaire jour/mois")

Range("A1") = "REF"
Range("B1") = "TYPE"
Range("C1") = "ADR"

Columns("B:B").Replace What:="PRA", Replacement:="DDD", LookAt:=xlPart, _
    SearchOrder:=xlByColumns, MatchCase:=True, SearchFormat:=False, _
    ReplaceFormat:=False

Columns("C:C").NumberFormat = "@"
For i = derlig To 2 Step -1
With Cells(i, 3)
texte = .Value
Dim x As Byte
For x = 2 To Len(texte)
    If Not IsNumeric(Mid(texte, x, 1)) Then Mid(texte, x, 1) = " "
Next x
texte = Replace(texte, " ", "")
dat = Application.WorksheetFunction.Text(.Offset(0, 1).Value, "dd/mm")
If Not Left(texte, 2) = "06" Or Not dat = critere Then
Rows(i & ":" & i).Delete
Else: .Value = texte
End If
End With
Next i

Columns("D:D").Delete

ChDir "C:\"
ActiveWorkbook.SaveAs Filename:= _
    "C:\anniversaire.csv", FileFormat:=xlCSV, _
    CreateBackup:=False

End Sub

15fichier-bidon10.xlsm (47.90 Ko)

Le 14/10/2008 à 23:39

re rien a dire ton code est plus court et mieu

par contre je l'ai executé sur une liste de 1000 personnes et mon code le fait en 3secondes par contre le tien est plus lent il marche mais juste plus lent en execution.

mais c'est vrais que le mien on y comprends rien, j'avais fais l'enregistreur de macro , avec pleins de macro que j'ai recoller apres.

lol

Rechercher des sujets similaires à "aide macro 2007"