XL 2019 Textes originaux et traductions en "cascade"

Blessmywill

XLDnaute Nouveau
Bonjour à tous,

Suite à mon dernier post, j'ai eu un raz de marée de bonnes solutions de la part de la communauté, et je vous remercie de tout mon cœur.

Je voulais vous soumettre un autre problème que je rencontre très souvent dans mon travail de traducteur : les documents en cascade.

Je m'explique : mes confrères chinois ont l'habitude, de proposer des traductions avec pour chaque paragraphe le texte original, et sa traduction.

Quand je reçois des documents Word ou Excel, je dois pouvoir séparer le texte original de la traduction en deux colonnes distinctes, pour ensuite le traiter, faire un audit sur la qualité de traduction.

Lorsque c'est un cours discours, je peux m'en sortir, mais quand le discours fait 30 pages, cela devient fastidieux de faire des copié collé.

Dans la colonne A, les cellules au nombre impair contiennent tout la langue originale (Chinois ou français), et les cellules pairs contiennent toujours le contenu (français ou chinois)

J'ai mis un fichier en pièce joint pour vous montrer exactement le résultat souhaité.

Je sais qu'il est possible de le faire par formule (par le biais de la fonction ligne associée à d'autres bricolages ingénieux, mais j'aimerais pour le coup le faire en VBA (que je puisse étudier le code pour apprendre), et que cela puisse sur une marge plage de la colonne 1 (Je me retrouve parfois avec 100 000 occurrences à faire à la main.)

Merci de votre retour !
 

Pièces jointes

  • Textes en cascade.xlsx
    11.8 KB · Affichages: 12
Solution
Re Bonjour Blessmywill, le forum

essaies ce code, augmentes le 100000 si il y a plus
[Edition: je te laisse la mise en forme à faire 👀 😉]
[Edition 2: finalement je t'ai aussi fait la mise en forme et un traitement sur 1 million de lignes (j'ai pas testé avec 1 million)
si tu veux garder la première colonne supprimes Columns("A:A").Delete Shift:=xlToLeft 👀 😉]

Bien cordialement

VB:
Sub Séparer_CH_FR()
    Dim Tableau_en_Cours, Tableau_Range As Range, Compteur As Long, Compteur2 As Long
    Columns("A:A").Copy
    Columns("B:C").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Set Tableau_Range = Range("A1:C" & Range("A1000000").End(xlUp).Row)
    Tableau_en_Cours = Tableau_Range.Value...

Bernard_XLD

XLDnaute Barbatruc
Membre du Staff
Re Bonjour Blessmywill, le forum

essaies ce code, augmentes le 100000 si il y a plus
[Edition: je te laisse la mise en forme à faire 👀 😉]
[Edition 2: finalement je t'ai aussi fait la mise en forme et un traitement sur 1 million de lignes (j'ai pas testé avec 1 million)
si tu veux garder la première colonne supprimes Columns("A:A").Delete Shift:=xlToLeft 👀 😉]

Bien cordialement

VB:
Sub Séparer_CH_FR()
    Dim Tableau_en_Cours, Tableau_Range As Range, Compteur As Long, Compteur2 As Long
    Columns("A:A").Copy
    Columns("B:C").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Set Tableau_Range = Range("A1:C" & Range("A1000000").End(xlUp).Row)
    Tableau_en_Cours = Tableau_Range.Value
    For Compteur = LBound(Tableau_en_Cours, 1) To UBound(Tableau_en_Cours, 1) Step 2
        Compteur2 = Compteur2 + 1
        Tableau_en_Cours(Compteur2, 2) = Tableau_en_Cours(Compteur, 1)
        Tableau_en_Cours(Compteur2, 3) = Tableau_en_Cours(Compteur + 1, 1)
    Next Compteur
    Application.Calculation = xlCalculationManual
    Tableau_Range.Value = Tableau_en_Cours
    Columns("A:A").Delete Shift:=xlToLeft
    Application.Calculation = xlCalculationAutomatic
    Set Tableau_Range = Nothing
    Set Tableau_en_Cours = Nothing
End Sub
 
Dernière édition:

MP59

XLDnaute Occasionnel
Bonjour à tous,
une autre approche.

VB:
Sub Mise_En_Forme()
Application.ScreenUpdating = False
Application.ActiveWorkbook.Sheets(1).Copy Before:=Worksheets("Feuil1")


Range("A1").CurrentRegion.Copy ActiveSheet.Range("B1")
Range("B1").Delete Shift:=xlUp
Derlign = LastRow(ActiveSheet)
For i = Derlign To 2 Step -2
    Cells(i, 1).EntireRow.Delete
Next i
Application.ScreenUpdating = False


End Sub
Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function
 

Pièces jointes

  • Textes en cascade_MP59.xlsm
    22.4 KB · Affichages: 3

Blessmywill

XLDnaute Nouveau
Bonjour à vous deux !

Décidément, je n'ai pas le temps de souffler, vous avez déjà fini !

Bernard_XLD, résultat parfait, je viens de tester un long doc de 40 pages, cela marche parfaitement. Je vais devoir apprendre beaucoup de choses avant de pouvoir m'inspirer de ton code.

MP59, un grand merci ! Votre approche est aussi très intéressante, en créant une nouvelle feuille. En lisant le code, je pense qu'il est plus accessible pour le néophyte que je suis.

En deux jours, j'ai pu obtenir deux fichiers qui me feront économiser des centaines d'heures de travail fastidieux et rébarbatifs.

Merci à tous !
 

chris

XLDnaute Barbatruc
RE
chris, j'ai vu sur le net la possibilité avec Power Query et une seule ligne de code.
VB:
= Table.FromRows(List.Split(Textes2[Colonnes],2))
Super ! j'achète.
Les List.... ont l'air très puissants

Vivement un manuel M digne de ce nom

On peut faire dans une seule requête
VB:
let
    Source = Excel.CurrentWorkbook(){[Name="Textes"]}[Content],
    Personnalisé1 = Table.FromRows(List.Split(Source[Colonne1],2)),
    #"Type modifié" = Table.TransformColumnTypes(Personnalisé1,{{"Column1", type text}, {"Column2", type text}})
in
    #"Type modifié"
 
Dernière édition:

Discussions similaires

Réponses
3
Affichages
996

Statistiques des forums

Discussions
312 156
Messages
2 085 819
Membres
102 992
dernier inscrit
KOSTIC