翻訳チェック用エクセルマクロ

英和・和英翻訳チェック時には、エクセルの両隣のセルに一文ずつ和文と英文とを並べて見比べながらチェックするのが効率的です。
そこで、エクセルに貼り付けた後にチェックしながらする処理として、「下セルと結合」、「セル削除」、「セル挿入」、および「上セルと結合」ボタンを作成しました。

ツール 翻訳

なお、マクロの内容は以下の通りです。

「セル挿入」

Sub セル挿入()

‘ セル挿入 Macro
‘ セルを挿入して下方向にシフトする


Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromAbove
End Sub

「セル削除」
Sub セル削除()

‘ セル削除 Macro
‘ セルを削除して上方向にシフトする


Selection.Delete Shift:=xlUp
End Sub

「下セルと結合」
Sub 下セルと結合()

‘ 下セルと結合 Macro
‘ 下セルの内容を結合する

‘ 選択セルをカウントして2以上ならばエラーを出す
Dim Num As Integer
Num = Selection.Count
If Num >= 2 Then
MsgBox “1つのセルだけを選択して下さい”, vbOKOnly + vbExclamation, “エラー”
Exit Sub
End If

‘ 選択したセルとその下のセルを選択
Range(Selection, ActiveCell.Offset(1, 0)).Select

‘ 選択したセル範囲の内容を結合
Dim objCell As Range
Dim strText As String
On Error Resume Next
Application.DisplayAlerts = False
strText = “”
For Each objCell In Selection
strText = strText & objCell.Text
Next
Selection.CONCATENATE = True
Selection.Value = strText
Application.DisplayAlerts = True

‘ 下のセルを選択して削除して上方向にシフトする
ActiveCell.Offset(1, 0).Delete Shift:=xlUp

‘ 選択範囲内の最上位のセルを選択
Selection(1).Select
End Sub

「上セルと結合」
Sub 上セルと結合()

‘ 上セルと結合 Macro
‘ 上セルの内容を結合する

‘ 選択セルをカウントして2以上ならばエラーを出す
Dim Num As Integer
Num = Selection.Count
If Num >= 2 Then
MsgBox “1つのセルだけを選択して下さい”, vbOKOnly + vbExclamation, “エラー”
Exit Sub
End If

‘ 選択したセルとその上のセルを選択
Range(Selection, ActiveCell.Offset(-1, 0)).Select

‘ 選択したセル範囲の内容を結合
Dim objCell As Range
Dim strText As String
On Error Resume Next
Application.DisplayAlerts = False
strText = “”
For Each objCell In Selection
strText = strText & objCell.Text
Next
Selection.CONCATENATE = True
Selection.Value = strText
Application.DisplayAlerts = True

‘ 下のセルを選択して削除して上方向にシフトする
ActiveCell.Offset(1, 0).Delete Shift:=xlUp

‘ 選択範囲内の最上位のセルを選択
Selection(1).Select
End Sub

○作者コメント
・本コンテンツを改良、変更、又は応用したコンテンツについて、本投稿のコメント欄に投稿して頂けると嬉しいです。
・本コンテンツについては、業としての利用を含み、自由に改変、複製、譲渡、公衆送信、及びその他の利用行為を行うことを許諾します。ただし、公序良俗に反する態様での利用行為については禁止します。
・私は、上記許諾範囲内において、本コンテンツに係る著作権、著作者人格権、及びその他のいかなる権利も行使しないことを約束します。
・本コンテンツ又は本コンテンツを改変などしたものの利用については、利用者が一切の責任を負い、作者は当該利用によって生じた結果についていかなる責任も負いません。

翻訳チェック前処理用ワードマクロ

英和・和英翻訳チェック時には、エクセルの両隣のセルに一文ずつ和文と英文とを並べて見比べながらチェックするのが効率的です。

そこで、エクセルに貼り付ける前処理として、原稿と翻訳文それぞれの一文ごとに改行が挿入された作業用文章を作成するためのマクロを作成しました。

ツール 改行

なお、マクロの内容は以下の通りです。

 

「和文改行のマクロ」

Sub 和文改行挿入()

‘ 和文改行挿入 Macro
‘ 和文文末に改行を挿入するマクロ

‘ 文末に改行を挿入
s1 = Array(“^l”, “。^p”, “。”, “】^p”, “^p^p”, “【発明の名称】”, “【技術分野】”, “【背景技術】”, “【先行技術文献】”, “【特許文献】”, “【非特許文献】”, “【発明の概要】”, “【発明が解決しようとする課題】”, “【課題を解決するための手段】”, “【図面の簡単な説明】”, “【発明を実施するための形態】”, “【発明の効果】”, “【符号の説明】”, “。^p)”, “。^p」”)
s2 = Array(“^p”, “。”, “。^p”, “】”, “^p”, “【発明の名称】^p”, “【技術分野】^p”, “【背景技術】^p”, “【先行技術文献】^p”, “【特許文献】^p”, “【非特許文献】^p”, “【発明の概要】^p”, “【発明が解決しようとする課題】^p”, “【課題を解決するための手段】^p”, “【図面の簡単な説明】^p”, “【発明を実施するための形態】^p”, “【発明の効果】^p”, “【符号の説明】^p”, “。)^p”, “。」^p”)
For i = 0 To UBound(s1)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = s1(i)
.Replacement.Text = s2(i)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next i

‘ ハイライトを赤太字に変更
Selection.Find.ClearFormatting
Selection.Find.Highlight = True
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = False
With Selection.Find.Replacement.Font
.Bold = True
.Color = wdColorRed
End With
With Selection.Find
.Text = “”
.Replacement.Text = “”
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

‘ ブックマーク位置に移動する
Selection.GoTo What:=wdGoToBookmark, Name:=”初期位置”

‘ カーソル位置から文末までを選択する
Selection.Extend
Selection.EndKey Unit:=wdStory
Selection.EscapeKey
Selection.Copy

End Sub

 

「英文改行のマクロ」

Sub 英文改行挿入2()

‘ 英文改行挿入 Macro
‘ 英文文末に改行を挿入するマクロ

‘ 小数点を除外
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = “([0-9]).([0-9])”
.Replacement.Text = “\1。\2”
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchFuzzy = False
.MatchWildcards = True
End With
Selection.Find.Execute Replace:=wdReplaceAll

‘ 文末に改行を挿入
s1 = Array(“.^p”, “. ^p”, “.  ^p”, “.”, “FIG.^p”, “FIGS.^p”, “Fig.^p”, “Figs.^p”, “U.^pS.^p”, “co.^p, Ltd”, “i.^pe.^p”, “e.^pg.^p”, “No.^p”, “et al.^p”, ” etc.^p”, “www.^p”, “Corp.^p,”, “.^pcom”, “.^phtml”, “.^p)”, “.^p]”, “。”)
s2 = Array(“.”, “.”, “.”, “.^p”, “FIG.”, “FIGS.”, “Fig.”, “Figs.”, “U.S.”, “co., Ltd”, “i.e.”, “e.g.”, “No.”, “et al.”, ” etc.”, “www.”, “Corp.,”, “.com”, “.html”, “.)^p”, “.]^p”, “.”)
For i = 0 To UBound(s1)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = s1(i)
.Replacement.Text = s2(i)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next i

‘ vbTabをスペースに置換
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = vbTab
.Replacement.Text = ” ”
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

‘ ハイライトを赤太字に変更
Selection.Find.ClearFormatting
Selection.Find.Highlight = True
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Highlight = False
With Selection.Find.Replacement.Font
.Bold = True
.Color = wdColorRed
End With
With Selection.Find
.Text = “”
.Replacement.Text = “”
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

‘ ブックマーク位置に移動する
Selection.GoTo What:=wdGoToBookmark, Name:=”初期位置”

‘ カーソル位置から文末までを選択する
Selection.Extend
Selection.EndKey Unit:=wdStory
Selection.EscapeKey
Selection.Copy

End Sub

 

○作者コメント
・本コンテンツを改良、変更、又は応用したコンテンツについて、本投稿のコメント欄に投稿して頂けると嬉しいです。
・本コンテンツについては、業としての利用を含み、自由に改変、複製、譲渡、公衆送信、及びその他の利用行為を行うことを許諾します。ただし、公序良俗に反する態様での利用行為については禁止します。
・私は、上記許諾範囲内において、本コンテンツに係る著作権、著作者人格権、及びその他のいかなる権利も行使しないことを約束します。
・本コンテンツ又は本コンテンツを改変などしたものの利用については、利用者が一切の責任を負い、作者は当該利用によって生じた結果についていかなる責任も負いません。