Boucle dans une macro ?

Le 25/04/2020 à 04:22

Bonsoir à Tous,

J'ai bidouillé une macro à partir d'une macro de Yvouille mais elle est vraiment tres rudimentaire.

Mon savoir en VBA est tres limite mais je pense que peut etre une boucle ferait l'affaire. A vous de voir.

[codeSub Separation()

Dim Position_Chr10 As Integer, Longueur As Integer, Début_texte As String, Fin_texte As String

Range("a1:a20").ClearContents

'Range("c1:c20").ClearContents

Sheets("Cours").Range("A2").FormulaLocal = "=RECHERCHEV($B2;'recettes'!b2:p700;11;0)"

Position_Chr10 = WorksheetFunction.Search(Chr(10), Range("A2"))

Longueur = Len(Range("A2"))

Début_texte = Mid(Range("A2").Text, 1, Position_Chr10 - 1)

Fin_texte = Mid(Range("A2").Text, Position_Chr10 + 1, Longueur - Position_Chr10)

Cells(2, 1).FormulaR1C1 = Début_texte

Cells(3, 1).FormulaR1C1 = Fin_texte

Position_Chr10 = WorksheetFunction.Search(Chr(10), Range("A3"))

Longueur = Len(Range("A3"))

Début_texte = Mid(Range("A3").Text, 1, Position_Chr10 - 1)

Fin_texte = Mid(Range("A3").Text, Position_Chr10 + 1, Longueur - Position_Chr10)

Cells(3, 1).FormulaR1C1 = Début_texte

Cells(4, 1).FormulaR1C1 = Fin_texte

Position_Chr10 = WorksheetFunction.Search(Chr(10), Range("A4"))

Longueur = Len(Range("A4"))

Début_texte = Mid(Range("A4").Text, 1, Position_Chr10 - 1)

Fin_texte = Mid(Range("A4").Text, Position_Chr10 + 1, Longueur - Position_Chr10)

Cells(4, 1).FormulaR1C1 = Début_texte

Cells(5, 1).FormulaR1C1 = Fin_texte

Position_Chr10 = WorksheetFunction.Search(Chr(10), Range("A5"))

Longueur = Len(Range("A5"))

Début_texte = Mid(Range("A5").Text, 1, Position_Chr10 - 1)

Fin_texte = Mid(Range("A5").Text, Position_Chr10 + 1, Longueur - Position_Chr10)

Cells(5, 1).FormulaR1C1 = Début_texte

Cells(6, 1).FormulaR1C1 = Fin_texte

Position_Chr10 = WorksheetFunction.Search(Chr(10), Range("A6"))

Longueur = Len(Range("A6"))

Début_texte = Mid(Range("A6").Text, 1, Position_Chr10 - 1)

Fin_texte = Mid(Range("A6").Text, Position_Chr10 + 1, Longueur - Position_Chr10)

Cells(6, 1).FormulaR1C1 = Début_texte

Cells(7, 1).FormulaR1C1 = Fin_texte

Position_Chr10 = WorksheetFunction.Search(Chr(10), Range("A7"))

Longueur = Len(Range("A7"))

Début_texte = Mid(Range("A7").Text, 1, Position_Chr10 - 1)

Fin_texte = Mid(Range("A7").Text, Position_Chr10 + 1, Longueur - Position_Chr10)

Cells(7, 1).FormulaR1C1 = Début_texte

Cells(8, 1).FormulaR1C1 = Fin_texte

Position_Chr10 = WorksheetFunction.Search(Chr(10), Range("A8"))

Longueur = Len(Range("A8"))

Début_texte = Mid(Range("A8").Text, 1, Position_Chr10 - 1)

Fin_texte = Mid(Range("A8").Text, Position_Chr10 + 1, Longueur - Position_Chr10)

Cells(8, 1).FormulaR1C1 = Début_texte

Cells(9, 1).FormulaR1C1 = Fin_texte

Position_Chr10 = WorksheetFunction.Search(Chr(10), Range("A9"))

Longueur = Len(Range("A9"))

Début_texte = Mid(Range("A9").Text, 1, Position_Chr10 - 1)

Fin_texte = Mid(Range("A9").Text, Position_Chr10 + 1, Longueur - Position_Chr10)

Cells(9, 1).FormulaR1C1 = Début_texte

Cells(10, 1).FormulaR1C1 = Fin_texte

Position_Chr10 = WorksheetFunction.Search(Chr(10), Range("A10"))

Longueur = Len(Range("A10"))

Début_texte = Mid(Range("A10").Text, 1, Position_Chr10 - 1)

Fin_texte = Mid(Range("A10").Text, Position_Chr10 + 1, Longueur - Position_Chr10)

Cells(10, 1).FormulaR1C1 = Début_texte

Cells(11, 1).FormulaR1C1 = Fin_texte

Position_Chr10 = WorksheetFunction.Search(Chr(10), Range("A11"))

Longueur = Len(Range("A11"))

Début_texte = Mid(Range("A11").Text, 1, Position_Chr10 - 1)

Fin_texte = Mid(Range("A11").Text, Position_Chr10 + 1, Longueur - Position_Chr10)

Cells(11, 1).FormulaR1C1 = Début_texte

Cells(12, 1).FormulaR1C1 = Fin_texte

Position_Chr10 = WorksheetFunction.Search(Chr(10), Range("A12"))

Longueur = Len(Range("A12"))

Début_texte = Mid(Range("A12").Text, 1, Position_Chr10 - 1)

Fin_texte = Mid(Range("A12").Text, Position_Chr10 + 1, Longueur - Position_Chr10)

Cells(12, 1).FormulaR1C1 = Début_texte

Cells(13, 1).FormulaR1C1 = Fin_texte

Position_Chr10 = WorksheetFunction.Search(Chr(10), Range("A13"))

Longueur = Len(Range("A13"))

Début_texte = Mid(Range("A13").Text, 1, Position_Chr10 - 1)

Fin_texte = Mid(Range("A13").Text, Position_Chr10 + 1, Longueur - Position_Chr10)

Cells(13, 1).FormulaR1C1 = Début_texte

Cells(14, 1).FormulaR1C1 = Fin_texte

Position_Chr10 = WorksheetFunction.Search(Chr(10), Range("A14"))

Longueur = Len(Range("A14"))

Début_texte = Mid(Range("A14").Text, 1, Position_Chr10 - 1)

Fin_texte = Mid(Range("A14").Text, Position_Chr10 + 1, Longueur - Position_Chr10)

Cells(14, 1).FormulaR1C1 = Début_texte

Cells(15, 1).FormulaR1C1 = Fin_texte

Position_Chr10 = WorksheetFunction.Search(Chr(10), Range("A15"))

Longueur = Len(Range("A15"))

Début_texte = Mid(Range("A15").Text, 1, Position_Chr10 - 1)

Fin_texte = Mid(Range("A15").Text, Position_Chr10 + 1, Longueur - Position_Chr10)

Cells(15, 1).FormulaR1C1 = Début_texte

Cells(16, 1).FormulaR1C1 = Fin_texte

Position_Chr10 = WorksheetFunction.Search(Chr(10), Range("A16"))

Longueur = Len(Range("A16"))

Début_texte = Mid(Range("A16").Text, 1, Position_Chr10 - 1)

Fin_texte = Mid(Range("A16").Text, Position_Chr10 + 1, Longueur - Position_Chr10)

Cells(16, 1).FormulaR1C1 = Début_texte

Cells(17, 1).FormulaR1C1 = Fin_texte

End Sub][/code]

Je vous remercie d'avance pour votre aide.

Le 25/04/2020 à 04:56

Bonjour

Le 25/04/2020 à 12:02

Bonjour à Tous,

Je joins un fichier exemple pour mieux illustrer ma macro.

Bien à vous Tous

6separer.xlsm (17.59 Ko)

Le 25/04/2020 à 12:34

Bonjour

Voila une macro avec Split A voir

Sub Test()
MaVar = Range("A2")
 FullName = Split(MaVar, Chr(10))
    For L = 0 To UBound(FullName)
        Cells(L + 2, 1).Value = FullName(L)
    Next L
End Sub

A+

Maurice

Le 25/04/2020 à 12:53

Bonjour Archer,

Merci beaucoup pour ta solution.

Elle semble bien correspondre à ce que je veux.

Bonne journée à Toi et à toute l'équipe de ce forum

Le 25/04/2020 à 18:27

Bonjour Archer,

Je te remercie encore pour cette réponse très élégante.

je dois appliquer ta macro à plusieurs cellules de la colonne "A".

Est ce qu'il y a moyen d'avoir une seule macro plutôt que de raccorder plusieurs fois la même macro

voici le code de ce que j'ai fait avec ta macro:

Sheets("Cours").Range("A2").FormulaLocal = "=RECHERCHEV($B2;'recettes'!b2:p700;11;0)"
MaVar = Range("A2")
 FullName = split(MaVar, Chr(10))
    For L = 0 To UBound(FullName)
        Cells(L + 2, 1).Value = FullName(L)
    Next L

Sheets("Cours").Range("A25").FormulaLocal = "=RECHERCHEV($B3;'recettes'!b2:p700;11;0)"
MaVar = Range("A25")
 FullName = split(MaVar, Chr(10))
    For L = 0 To UBound(FullName)
        Cells(L + 25, 1).Value = FullName(L)
    Next L

Sheets("Cours").Range("A50").FormulaLocal = "=RECHERCHEV($B4;'recettes'!b2:p700;11;0)"
MaVar = Range("A50")
 FullName = split(MaVar, Chr(10))
    For L = 0 To UBound(FullName)
        Cells(L + 50, 1).Value = FullName(L)
    Next L 

Sheets("Cours").Range("A75").FormulaLocal = "=RECHERCHEV($B5;'recettes'!b2:p700;11;0)"
MaVar = Range("A75")
 FullName = split(MaVar, Chr(10))
    For L = 0 To UBound(FullName)
        Cells(L + 75, 1).Value = FullName(L)
    Next L

Sheets("Cours").Range("A100").FormulaLocal = "=RECHERCHEV($B6;'recettes'!b2:p700;11;0)"
MaVar = Range("A100")
 FullName = split(MaVar, Chr(10))
    For L = 0 To UBound(FullName)
        Cells(L + 100, 1).Value = FullName(L)
    Next L

Je te remercie par avance pour ton aide.

Le 25/04/2020 à 19:18

Bonjour

donne au moins un modèle de ton fichier pour voir se que je peux faire

A+

Maurice

Le 25/04/2020 à 19:40

Bonsoir Archer,

Tout d'abord merci ^pour ton aide

Voici mon fichier exemple avec la macro que j'ai essayé de faire mais qui ne va pas.

Bien Cordialement

6separer.xlsm (17.35 Ko)

Rechercher des sujets similaires à "boucle macro"