test sur présence article en début de cellule et report

Le
jipeache
Bonjour, et meilleurs vœux à tous.

J'ai un fichier de 2800 lignes et 1 colonne que je voudrais tester de
la façon suivante (pour créer un index avec report de l'article en
fin) : si le début de la cellule comprend "Le", "La", "Les", "L'",
copier la cellule sans cet article au début et le rajouter à la fin
entre parenthèses avec un espace avant.

Ex : "L'enquête de Sully sur l'artillerie en 1604" doit devenir
"enquète de Sully sur l'artillerie en 1604 (L')" avec, cerise sur le
gâteau si possible, une majuscule à "Enquète" ? ; mais
"Observations sur le patronage des églises en Normandie" ne doit pas
bouger.

Des experts en macro auraient une solution ?
Merci d'avance
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
michdenis
Le #18437011
Tu adaptes le nom de la feuille et de la plage de cellules
tes données seront recopiées dans la colonne adjacentes, à droite.


Sub test()
Dim Rg As Range, C As Range
With Feuil2 ' à adapter
Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
For Each C In Rg
If C <> "" Then
xx = UCase(Trim(Left(C, 2)))
Select Case UCase(Trim(Left(C, 2)))
Case Is = "L'"
C.Offset(, 1).Value = Right(C, Len(C) - 2) & " (L')"
Case Is = "LE"
C.Offset(, 1).Value = Right(C, Len(C) - 3) & " (Le)"
Case Is = "LA"
C.Offset(, 1).Value = Right(C, Len(C) - 3) & " (La)"

End Select
End If
Next
End Sub





"jipeache"
Bonjour, et meilleurs vœux à tous.

J'ai un fichier de 2800 lignes et 1 colonne que je voudrais tester de
la façon suivante (pour créer un index avec report de l'article en
fin) : si le début de la cellule comprend "Le", "La", "Les", "L'",
copier la cellule sans cet article au début et le rajouter à la fin
entre parenthèses avec un espace avant.

Ex : "L'enquête de Sully sur l'artillerie en 1604" doit devenir
"enquète de Sully sur l'artillerie en 1604 (L')" avec, cerise sur le
gâteau si possible, une majuscule à "Enquète..." ? ; mais
"Observations sur le patronage des églises en Normandie" ne doit pas
bouger.

Des experts en macro auraient une solution ?
Merci d'avance
FFO
Le #18437151
Salut à toi

Je te propose ce code :

i = 2
Do While i < Range("A65535").End(xlUp).Offset(1, 0).Row
If Range("A" & i) Like "Le *" Or Range("A" & i) Like "La *" Or Range("A" &
i) Like "L'*" Then
Range("B" & i) = Application.WorksheetFunction.Proper(Mid(Range("A" & i),
3)) & " (" & Mid(Range("A" & i), 1, 2) & ")"
Else
If Range("A" & i) Like ("Les *") Then
Range("B" & i) = Application.WorksheetFunction.Proper(Mid(Range("A" & i),
4)) & " (" & Mid(Range("A" & i), 1, 3) & ")"
Else
Range("B" & i) = Range("A" & i)
End If
End If
i = i + 1
Loop

Résultat en colonne B

Celà devrait te convenir

Dis moi !!!!
jipeache
Le #18437511
On 20 jan, 15:23, FFO
Salut à toi

Je  te propose ce code :

i = 2
Do While i < Range("A65535").End(xlUp).Offset(1, 0).Row
If Range("A" & i) Like "Le *" Or Range("A" & i) Like "La *" Or Range("A" &
i) Like "L'*" Then
Range("B" & i) = Application.WorksheetFunction.Proper(Mid(Range("A" & i ),
3)) & " (" & Mid(Range("A" & i), 1, 2) & ")"
Else
If Range("A" & i) Like ("Les *") Then
Range("B" & i) = Application.WorksheetFunction.Proper(Mid(Range("A" & i ),
4)) & " (" & Mid(Range("A" & i), 1, 3) & ")"
Else
Range("B" & i) = Range("A" & i)
End If
End If
i = i + 1
Loop

Résultat en colonne B

Celà devrait te convenir

Dis moi !!!!




Cela ne fonctionne pas.
Etant proche de la nullité en macro, j'ai un message disant en gros
"Else sans If" (sur le dernier Else).
Je ne comprends pas trop car je vois bien les 2 tests If...Then ?
Merci
jipeache
Le #18437781
On 20 jan, 15:08, "michdenis"
Tu adaptes le nom de la feuille et de la plage de cellules
tes données seront recopiées dans la colonne adjacentes, à droite.

Sub test()
Dim Rg As Range, C As Range
With Feuil2 ' à adapter
   Set Rg = .Range("A1:A" & .Range("A65536").End(xlUp).Row)
End With
For Each C In Rg
    If C <> "" Then
        xx = UCase(Trim(Left(C, 2)))
        Select Case UCase(Trim(Left(C, 2)))
            Case Is = "L'"
                C.Offset(, 1).Value = Right(C, Len(C) - 2) & " (L')"
            Case Is = "LE"
                C.Offset(, 1).Value = Right(C, Len(C) - 3) & " (Le)"
            Case Is = "LA"
                C.Offset(, 1).Value = Right(C, Len(C) - 3) & " (La)"

        End Select
    End If
Next
End Sub



Bonjour et merci,
mais cela ne fonctionne pas ou alors je m'y prends mal.
J'ai modifié ainsi :

Sub testarticledebut2()
Dim Rg As Range, C As Range
With Feuil1
Set Rg = .Range("A1:A2958" & .Range("A65536").End(xlUp).Row)
End With
For Each C In Rg
If C <> "" Then
xx = UCase(Trim(Left(C, 2)))
Select Case UCase(Trim(Left(C, 2)))
Case Is = "L'"
C.Offset(, 1).Value = Right(C, Len(C) - 2) & " (L')"
Case Is = "LE"
C.Offset(, 1).Value = Right(C, Len(C) - 3) & " (Le)"
Case Is = "LA"
C.Offset(, 1).Value = Right(C, Len(C) - 3) & " (La)"

End Select
End If
Next
End Sub

Rien ne se passe ???
Merci
FFO
Le #18438011
Rebonjour à toi

Tu as eu certainement des problèmes de recopie (lignes scindées en 2 )

Sur ce lien un exemple avec mon code en l'état

Ouvres le et actives le bouton "Traitement"
Résultat en colonne B

Va voir le code de la Macro

Donnes moi des nouvelles !!!!

http://www.cijoint.fr/cjlink.php?file=cj200901/cij4icR3YB.xls
Daniel.j
Le #18437991
Cette macro doit le faire
Elle met les articles du debut a la fin et entre parentheses !

Sub ArticEnFin()
ArticLes = Array("LA", "LE", "LES", "L'", "UN", "UNE", "DES", "DU",
"D'", "AU", "AUX")
For Each LaCell In Selection: For Each ArticLe In ArticLes
L = Len(ArticLe)
If UCase(Left(LaCell.Formula, L)) = ArticLe Then
LaCell.Value = UCase(Mid(LaCell, L + 1, 1)) + Mid(LaCell, L + 2) + "(" +
RTrim(Left(LaCell, L)) + ")"
Exit For
End If
Next: Next
End Sub

Daniel

--
FAQ MPFE
http://dj.joss.free.fr/faq.htm

VBAXL
http://dj.joss.free.fr/
"jipeache"
Bonjour, et meilleurs vœux à tous.

J'ai un fichier de 2800 lignes et 1 colonne que je voudrais tester de
la façon suivante (pour créer un index avec report de l'article en
fin) : si le début de la cellule comprend "Le", "La", "Les", "L'",
copier la cellule sans cet article au début et le rajouter à la fin
entre parenthèses avec un espace avant.

Ex : "L'enquête de Sully sur l'artillerie en 1604" doit devenir
"enquète de Sully sur l'artillerie en 1604 (L')" avec, cerise sur le
gâteau si possible, une majuscule à "Enquète..." ? ; mais
"Observations sur le patronage des églises en Normandie" ne doit pas
bouger.

Des experts en macro auraient une solution ?
Merci d'avance
Jacquouille
Le #18439321
Bonsoir Daniel
J'aime cette approche...au cas où on aurait un titre du genre "Larme humide"
ou, très San A, "Lard salé". -)

--
Bien amicalmement,
"Le vin est au repas ce que le parfum est à la femme."

Jacquouille.

"Daniel.j"
Cette macro doit le faire
Elle met les articles du debut a la fin et entre parentheses !

Sub ArticEnFin()
ArticLes = Array("LA", "LE", "LES", "L'", "UN", "UNE", "DES", "DU",
"D'", "AU", "AUX")
For Each LaCell In Selection: For Each ArticLe In ArticLes
L = Len(ArticLe)
If UCase(Left(LaCell.Formula, L)) = ArticLe Then
LaCell.Value = UCase(Mid(LaCell, L + 1, 1)) + Mid(LaCell, L + 2) + "("
+ RTrim(Left(LaCell, L)) + ")"
Exit For
End If
Next: Next
End Sub

Daniel

--
FAQ MPFE
http://dj.joss.free.fr/faq.htm

VBAXL
http://dj.joss.free.fr/
"jipeache"
Bonjour, et meilleurs voux à tous.

J'ai un fichier de 2800 lignes et 1 colonne que je voudrais tester de
la façon suivante (pour créer un index avec report de l'article en
fin) : si le début de la cellule comprend "Le", "La", "Les", "L'",
copier la cellule sans cet article au début et le rajouter à la fin
entre parenthèses avec un espace avant.

Ex : "L'enquête de Sully sur l'artillerie en 1604" doit devenir
"enquète de Sully sur l'artillerie en 1604 (L')" avec, cerise sur le
gâteau si possible, une majuscule à "Enquète..." ? ; mais
"Observations sur le patronage des églises en Normandie" ne doit pas
bouger.

Des experts en macro auraient une solution ?
Merci d'avance



Daniel.j
Le #18439541
Bonsoir
Je l'ai retrouve au fond d'un tiroir .... mais je sais plus qui en est
l'auteur !
Daniel


"Jacquouille" news: %
Bonsoir Daniel
J'aime cette approche...au cas où on aurait un titre du genre "Larme
humide" ou, très San A, "Lard salé". -)

--
Bien amicalmement,
"Le vin est au repas ce que le parfum est à la femme."

Jacquouille.

"Daniel.j"
Cette macro doit le faire
Elle met les articles du debut a la fin et entre parentheses !

Sub ArticEnFin()
ArticLes = Array("LA", "LE", "LES", "L'", "UN", "UNE", "DES", "DU",
"D'", "AU", "AUX")
For Each LaCell In Selection: For Each ArticLe In ArticLes
L = Len(ArticLe)
If UCase(Left(LaCell.Formula, L)) = ArticLe Then
LaCell.Value = UCase(Mid(LaCell, L + 1, 1)) + Mid(LaCell, L + 2) + "("
+ RTrim(Left(LaCell, L)) + ")"
Exit For
End If
Next: Next
End Sub

Daniel

--
FAQ MPFE
http://dj.joss.free.fr/faq.htm

VBAXL
http://dj.joss.free.fr/
"jipeache"
Bonjour, et meilleurs voux à tous.

J'ai un fichier de 2800 lignes et 1 colonne que je voudrais tester de
la façon suivante (pour créer un index avec report de l'article en
fin) : si le début de la cellule comprend "Le", "La", "Les", "L'",
copier la cellule sans cet article au début et le rajouter à la fin
entre parenthèses avec un espace avant.

Ex : "L'enquête de Sully sur l'artillerie en 1604" doit devenir
"enquète de Sully sur l'artillerie en 1604 (L')" avec, cerise sur le
gâteau si possible, une majuscule à "Enquète..." ? ; mais
"Observations sur le patronage des églises en Normandie" ne doit pas
bouger.

Des experts en macro auraient une solution ?
Merci d'avance







michdenis
Le #18439931
Es-tu certain d'avoir modifier le nom de la feuille
correctement dans la procédure. Mon exemple
prenait la Feuil1.

Et attention à cette ligne de code, tu as fait une erreur
de syntaxe en définissant la ligne de code...
Set Rg = .Range("A1:A" & .Range("A2958").End(xlUp).Row)

Sub testarticledebut2()
Dim Rg As Range, C As Range
With Feuil1 ' à définir
Set Rg = .Range("A1:A" & .Range("A2958").End(xlUp).Row)
End With
For Each C In Rg
If C <> "" Then
Select Case UCase(Left(Trim(C), 2))
Case Is = "L'"
C.Offset(, 1).Value = Right(C, Len(C) - 2) & " (L')"
Case Is = "LE"
C.Offset(, 1).Value = Right(C, Len(C) - 3) & " (Le)"
Case Is = "LA"
C.Offset(, 1).Value = Right(C, Len(C) - 3) & " (La)"
Case Else
C.Offset(, 1).Value = C.Value
End Select
End If
Next
End Sub
Publicité
Poster une réponse
Anonyme