XL 2019 Copier une partie de contenu d'une cellule dans une autre - Macro

[Blessmywill]

Bonjour à tous,

Je suis traducteur et prof domicilié à Pékin. Dans le cadre de mon travail, je reçois des fichiers de glossaire de mes collègues chinois. Même je leur dis souvent de mettre les infos dans deux colonnes distinctes, c'est rarement fait

J'aimerais du coup trouver une macro qui me permette de séparer le texte en chinois du texte français.

Je suis débutant en macro, donc tous vos conseils et votre aide sont les bienvenus.
Je vous laisse un document pour vous montrer ce que je souhaiterai obtenir comme résultat.

Bien à vous,

 

[Bernard_XLD]

Bonjour Blessmywill, le forum

Une proposition en formule avec ta chaine en A1,
formule en B1 =GAUCHE(DROITE(A1;NBCAR(A1)-CHERCHE(" ";A1;1));CHERCHE(" ";DROITE(A1;NBCAR(A1)-CHERCHE(" ";A1;1));1))
formule en C1 =DROITE(DROITE(A1;NBCAR(A1)-CHERCHE(" ";A1;1));NBCAR(DROITE(A1;NBCAR(A1)-CHERCHE(" ";A1;1)))-CHERCHE(" ";DROITE(A1;NBCAR(A1)-CHERCHE(" ";A1;1));1))
voir fichier joint

Bien cordialement

 

[Hasco]

bonjour,

Dans le fichier joint, une extraction par power query (présent dans xl 2019) en colonne C et par formule un peu plus loin (E:F).

Cordialement

 

[Jacky67]

Bonjour à tous,

Je suis traducteur et prof domicilié à Pékin. Dans le cadre de mon travail, je reçois des fichiers de glossaire de mes collègues chinois. Même je leur dis souvent de mettre les infos dans deux colonnes distinctes, c'est rarement fait

J'aimerais du coup trouver une macro qui me permette de séparer le texte en chinois du texte français.

Je suis débutant en macro, donc tous vos conseils et votre aide sont les bienvenus.
Je vous laisse un document pour vous montrer ce que je souhaiterai obtenir comme résultat.

Bien à vous,

Bonjour à tous
Une proposition par macro avec ce code

Sub extrait()
    Dim i&, C
    Columns(2).Clear
    For Each C In Range("a1:a" & Cells(Rows.Count, "A").End(xlUp).Row)
        For i = 1 To Len([C])
            If Asc(Mid([C], i, 1)) > 64 And IsNumeric(Left(C, 1)) Then
                C.Offset(, 1) = Mid([C], i, 9 ^ 9)
                Exit For
            End If
        Next
    Next
End Sub

 

[Blessmywill]

Bonsoir Jacky,

Permettez moi dans un premier de saluer votre professionnalisme et votre rapidité pour cet épineux problème (pour moi hahaha). La formule fonctionne parfaitement pour extraire le texte français en un éclair (il me fallait des heures de travail pour réaliser cette opération qui désormais ne prend plus que quelques secondes ).

Je vais essayer de comprendre la formule en détail pour la reproduire dans de futurs travaux.

Pourrais-je abuser de votre gentillesse en m'aidant à mettre le texte chinois dans la colonne B et le texte français dans la colonne C ?

Je dois vraiment affuter mes connaissances en VBA, c'est vraiment un outil formidable pour mon travail de traducteur.

Un grand merci à vous !

 

[Blessmywill]

Oups, je viens de me rendre compte que deux autres personnes m'ont déjà répondu... Roblonchon, Bernard_XLD, toutes mes excuses !!!

Je regarde vos solutions proposées, qui sans doute m'apporteront une grande aide !

 

[Bernard_XLD]

Re bonjour le fil

avec une fonction personnalisée qui détecte les caractères hors table Ascii standard et retourne selon le paramètre (CH/FR)

Cordialement
[édition : -> post 17]

 

[Blessmywill]

Bon, je suis stupéfait par ces trois approches différentes, mais toutes aussi efficaces.

Bernard_XLD, votre solution par formules se rapproche le plus de ce que cherche comme résultat, à savoir enlever les chiffres, mettre le chinois en B, et le français en C. Si mon collègue chinois ne colle pas le texte français au chinois, ce marche du tonnerre de dieu.

Quand à votre approche avec une fonction personnalisée, elle permet d'obtenir exactement le résultat que je souhaite. Pour avoir les contenus bruts sans formule, je peux faire un copié collé des valeurs dans les colonnes D et E, et j'ai le résultat parfait.

Roblonchon, votre approche via power query m'a permis de prendre conscience de l'existence de cette solution. Je ne connais rien du tout sur ce point, j'ai commencé à regarder le mécanisme, je pense que je dois aussi étudier cette approche pour d'autres travaux auxquels je serai confronté. Merci encore de ce coup de maître !

Si j'arrive à obtenir le résultat de l'approche de Yeahou avec l'approche de Jacky en VBA (qui me semble plus à mon niveau, c'est vraiment pour progresser en VBA hahhaha) , je crois que je pourrai vous bénir toute ma vie depuis ma douce Chine.

En espérant vous lire

 

[Hasco]

re,


感谢您的反馈
Gǎnxiè nín de fǎnkuì (google traduction)

A bientôt

 

[Bernard_XLD]

Re le fil

une petite amélioration pour gérer le cas ou il n'y a aucun caractère chinois

Cordialement, @+

[édition : -> post 17]

 

[job75]

Bonjour Blessmywill, bienvenue sur XLD,

Voyez le fichier joint et la macro du bouton :

Sub Resultat()
Dim tablo, i&, x$, j%
tablo = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide
For i = 1 To UBound(tablo)
    x = tablo(i, 1)
    j = InStr(x, ",")
    If j Then If IsNumeric(Left(x, j - 1)) Then x = Mid(x, j + 1)
    For j = 1 To Len(x)
        If UCase(Mid(x, j, 1)) Like "[A-Z]" Then Exit For
    Next j
    tablo(i, 1) = Trim(Left(x, j - 1))
    tablo(i, 2) = Mid(x, j)
Next i
'---restitution---
With Sheets("Résultat")
    .[A1].Resize(i - 1, 2) = tablo
    .[A1].Offset(.Rows.Count - i + 1, 2).ClearContents 'RAZ en dessous
    .Columns.AutoFit 'ajustement largeurs
    .Activate 'facultatif
End With
End Sub

Edit : je reviens de déjeuner et je vois qu'il y a du monde, bonjour à tous.

A+

 

[Bernard_XLD]

re le fil
[édition: salut Job75, je ne t'avais point vu !]

Si j'arrive à obtenir le résultat de l'approche de Yeahou avec l'approche de Jacky en VBA

suffit de demander [édition: je viens de recharger, j'avais laissé passer un bug]
[édition : -> post 17]

 

[Blessmywill]

Re Bernard_XLD,

Alors chose étrange, votre avant dernière solution tronque le premier caractère chinois :
par exemple, pour 与某国签署互不侵犯对方网络空间条约 (oui, pour le coup c'est vraiment du chinois !), on obtient comme résultat 某国签署互不侵犯对方网络空间条约.

Quand à votre dernière solution, elle tronque le dernier caractère, c'est à dire :
Pour 与某国签署互不侵犯对方网络空间条约, on obtient 与某国签互不侵对方网络空间条.

Étrange, mais bon, pourquoi pas, je peux le rajouter à la main au pire.

Job 75, bonsoir et merci pour cette participation ! Votre approche est celle qui fonctionne le plus chez moi, sauf qu'elle n'aime pas quand le premier caractère est un accent aigu grave ou circonflexe.

Je reste abasourdi par tant de réactivité, c'est Noël avant l'heure !

 

[job75]

Job 75, bonsoir et merci pour cette participation ! Votre approche est celle qui fonctionne le plus chez moi, sauf qu'elle n'aime pas quand le premier caractère est un accent aigu grave ou circonflexe.

Ou tout caractère accentué au début du texte français, alors utilisez ce fichier (2) avec :

Sub Resultat()
Dim tablo, i&, x$, j%, y$
tablo = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide
For i = 1 To UBound(tablo)
    x = tablo(i, 1)
    j = InStr(x, ",")
    If j Then If IsNumeric(Left(x, j - 1)) Then x = Mid(x, j + 1)
    For j = 1 To Len(x)
        y = UCase(Mid(x, j, 1))
        If y Like "[A-Z]" Or InStr("ÀÁÂÃÄÅÒÓÔÕÖØÈÉÊËÌÍÎÏÙÚÛÜÑÇ", y) Then Exit For
    Next j
    tablo(i, 1) = Trim(Left(x, j - 1))
    tablo(i, 2) = Mid(x, j)
Next i
'---restitution---
With Sheets("Résultat")
    .[A1].Resize(i - 1, 2) = tablo
    .[A1].Offset(.Rows.Count - i + 1, 2).ClearContents 'RAZ en dessous
    .Columns.AutoFit 'ajustement largeurs
    .Activate 'facultatif
End With
End Sub

 

[Blessmywill]

Bernard_XLD, tout fonctionne sauf si le texte Français est collé (pas d'espace) avec le texte chinois dans les post 10 et 12.

Job75, solution parfaite, tout fonctionne. Je viens de le faire sur un fichier de 100 occurrences, la machine n'a pas tremblé.

Je sens que je vais avoir de la lecture pour comprendre toutes vos solutions. Je vous remercie de tout mon coeur pour votre précieuse aide.

Pour finir ce bel échange, je vous propose un proverbe chinois très approprié à notre situation actuelle :

山川异域，风月同天。shānchuān yìyù, fēngyuè tóng tiān.

Ma traduction pour ce proverbe serait :

Monts et cours d'eau ont beau nous séparer,
Sous la lune nos âmes demeurent liées.

Ce qui signifie en gros : qu'importe la distance, les séparations, nous sommes ici dans cette même terre, réunis autour de mêmes passions.

Merci pour tout !