(VBA) 処理から外すコードを追加
翻訳処理を行っています。
処理DATAはA列で1グループが以下の構造です。
連番(1から始まる)
表示時間(開始時間 --> 終了時間なので必ず文字列の「-->」を含んでいます)
字幕部分(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
補足
恐らくキーはEメジャーでベース音はA→B→C#→F#を繰り返してました メロディとベース音を楽譜にすると以下の画像のようになります https://m.imgur.com/To30cqi?r