(VBA) 処理から外すコードを追加

質問

翻訳処理を行っています。

処理DATAはA列で１グループが以下の構造です。

　連番（１から始まる）
　表示時間（開始時間 --> 終了時間なので必ず文字列の「-->」を含んでいます）
　字幕部分（1-3行）
　区切り(""相当）

参考（SRTファイル構造）
https://docs.fileformat.com/ja/video/srt/

現在は、
ネットに1行ずつ送って処理してるのでサンプルDATAが90行で13秒程必要です。

連番部分と表示時間部分はネットに送る必要が無いので
これを省くとかなり高速化が見込めると思うのですが
以下のコードで連番部分と表示時間部分を処理から外すコードを教えてください。

Sub 翻訳withGoogle()

Dim ln As Long
Dim i As Long
Dim startTime As Double
Dim endTime As Double
Dim processTime As Double
Dim ws2 As Worksheet

Set ws2 = Worksheets("Slim")

ln = ws2.Cells(Rows.Count, "A").End(xlUp).Row '最終行番号の取得
MsgBox "処理に時間が必要です。　気長に待ってください."

'日本語化 書き出し列(B)の初期化
ws2.Columns(2).Clear

'英文の翻訳(A列)を対象に日本語に翻訳
Dim temp()
temp = ws2.Range("A1").Resize(ln, 1).Value
Dim result()
ReDim result(1 To UBound(temp), 1 To 1)

'開始時間取得
startTime = Timer

Dim objHTTP As Object, oHtml As Object
Set objHTTP = CreateObject("MSXML2.ServerXMLHTTP")
Set oHtml = CreateObject("htmlfile")

For i = LBound(temp, 1) To UBound(temp, 1)
'HTTPリクエストのURL設定
Const SRC_URL As String = "https://translate.google.pl/m?hl=jp&sl=en&tl=jp&ie=UTF-8&prev=_m&q="
Dim url As String
url = SRC_URL & temp(i, 1)

'HTTPリクエスト
objHTTP.Open "GET", url, False
objHTTP.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
objHTTP.send ("")
'翻訳結果の取得 - HTTPリクエストのレスポンステキストを取得
oHtml.body.innerHTML = objHTTP.responseText
'翻訳結果を取得
Dim transtext As String
transtext = oHtml.getElementsByClassName("result-container")(0).innerText

'翻訳結果があればClean関数を実行、なければエラー出力
If transtext <> "" Then
result(i, 1) = Clean(transtext)
Else
result(i, 1) = CVErr(xlErrValue)
End If
Next

'SlimシートのC列に日本語化した翻訳を書き出す
ws2.Range("B1").Resize(ln, 1).Value = result

'エラーセルを処理
For i = 1 To ln
If IsError(Cells(i, "B").Value) Then
Cells(i, "B") = ""
End If
Next

'終了時間取得
endTime = Timer
'処理時間計算
processTime = endTime - startTime

MsgBox "翻訳終了 / 処理時間：" & processTime

Set ws2 = Nothing
Set objHTTP = Nothing
Set oHtml = Nothing

End Sub

回答No.4

kkkkkm · ベストアンサー

> シート上の最終行番号 : 6319　です。

なのに

ln = ws2.Cells(Rows.Count, "A").End(xlUp).Row '最終行番号の取得
のlnが
ln : 6322

なのは変ですね。最後に何か目に見えない怪しいデータがあるのかもしれませんね。それが""として処理されたのかも。
6320行目にそのデータ(""になった)があったらその時に

i = i + 3

で、iが6323になるので(i: 6323の結果と一致します)

url = SRC_URL & temp(i, 1)

でエラーになります。

それで
Dim url As String
If temp(i, 1) = "" Then '*　　追加
i = i + 3 '*　　追加
ElseIf temp(i, 1) = 1 Then '*コメントアウト　---
'i = i + 2 '*　　コメントアウト　---
End If '*　　追加

の部分を
Dim url As String
If temp(i, 1) = "" Then '*　　追加
i = i + 3 '*　　追加
If i > ln Then
Exit For
End If
End If '*　　追加

最終行の値よりiが大きくなったらループを抜けるを追加してみてください。

前回と同じように数値かつ""ではない連番の行を見つけてそこから2行飛ぶというのに変更しようと思ったのですが、前回は多重ループ(連番を見つけるループの中に翻訳文字の取り出しループ)使ってたので変更がややこしくなりそうでやめました。

前回といい今回といい""にやられました。

お礼

追加のコードありがとうございます。

＞最後に何か目に見えない怪しいデータがあるのかもしれませんね。
＞それが""として処理されたのかも。

ビンゴです。

試しに翻訳前の処理列（A列）をコピペして
テキストエディターに読み込ませたら6319，6320，6321行に
改行文字が入っていました。
改め元DATAを調べた同じ状況なので元DATA自体にゴミが紛れ込んでいました。

最終行の値よりiが大きくなったらループを抜けるコードを追加して
エラー無く処理できました。

ちなみに処理時間は、268秒（４分２８秒）でした。
（当初コード変更前は、予想では912秒だったので十分処理時間短縮となりました。）

お陰様で今回も先が見えました。
処理の見込みがたったので他の実DATAで処理を行ってみたいと思います。

ありがとうございました。

回答No.3

kkkkkm

一行にしたら問題が発覚したということですか、残念でしたね。
前回の案の
ElseIf temp(i, 1) = 1 Then
i = i + 2
の部分ですが、最初の連番だけの処理ですので、ループの始まりを連番1の字幕部分(先頭から3行目でしょうか)からはじめたら上記部分は不要になり、""じゃない場合に毎回1と比較する時間は節約できると思います(といってもムチャかすかな時間だと思いますが)

お礼

方針を変更してすいません。

コードを変更して試してみました。

For i = LBound(temp, 1) To UBound(temp, 1)
'HTTPリクエストのURL設定
Const SRC_URL As String = "https://translate.google.pl/m?hl=jp&sl=en&tl=jp&ie=UTF-8&prev=_m&q="
Dim url As String
If temp(i, 1) = "" Then '*　　追加
i = i + 3 '*　　追加
ElseIf temp(i, 1) = 1 Then '*コメントアウト　---
'i = i + 2 '*　　コメントアウト　---
End If '*　　追加

テストDATA（91行）で短時間化が上手く処理できたので
6319行の実DATAで試したのですがエラーが発生しました。

url = SRC_URL & temp(i, 1)
インデックスが有効範囲にありません。

エラー時でチェックの結果
ローカルウインドウで
　　ln : 6322
　　i: 6323

　　temp (1 to 6322,1 to 1)
　　result((1 to 6322,1 to 1)
なのに
シート上の最終行番号 : 6319　です。

とりあえず
transtextをみたら最終の6319を翻訳していました。

実DATAでエラーが出る原因はどこにあるのが不明なので
どこをチェックすれば良いでしょうか　？

回答No.2

kkkkkm

あと

Dim url As String
url = SRC_URL & temp(i, 1)

のところを

Dim url As String
If temp(i, 1) = "" Then
i = i + 3
ElseIf temp(i, 1) = 1 Then
i = i + 2
End If
url = SRC_URL & temp(i, 1)

に変更するとか

""だと3行飛んで1(連番の最初だけ)だと2行飛ぶという処理です。

回答No.1

kkkkkm

前回
https://okwave.jp/qa/q10197169.html
で字幕の部分だけを取り出していたと思うのですが、そのデータを送信すればいいのではないでしょうか。

お礼

回答感謝します。

＞前回で字幕の部分だけを取り出していたと思うのですが

No2の改正候補はまだ試していませんが

以下が変更理由です。

前回は、１行にすると翻訳の精度が少し上がりそうなので思い付きで１行にしてみたのですが。。。

実際複数行の字幕の部分を１行にして字幕部分だけを取り出した結果
実際動画に字幕を付けて再生した場合
これだと１行分の文字数が長すぎる事が多くて
視認性を良くする為に字幕文字を大きくすると字幕を読み切らないうちに
表示が消えてしまったり、
１行に入りきらないで変な所で改行されてしまいます。

以上の理由により１行化して字幕部分だけ別の列に集めて字幕部分だけを翻訳処理すると言う
前回の処理方法をとりあえず変更する事にしました。

字幕部分だけ別の列に集めると言う作業を行っていないので
翻訳する必要が無い連番部分と表示時間部分がじゃまになっています。

（最初の相談で記載しましたように
連番部分と表示時間部分は翻訳には無関係でネットに送るとそれだけ翻訳作業に時間が必要で
処理時間が長くなります。
そこでこれを省くとかなり高速化が見込めると思っています。）