Option Explicit
Option Base 1
'--------------------------------------------------
'プロシージャの概要:
'処理名:コメントトークン化処理
'概要:t01c_連結コードStep1テーブルのコメント部分をトークンに置換してt02d_トークン化テーブルを作成する
'--------------------------------------------------
Public Sub prcCreateコメントトークン化()
Const C_TABLE_SOURCE As String = "t01c_連結コードStep1"
Const C_TABLE_TARGET As String = "t02d_トークン化"
Const C_TABLE_TOKEN As String = "t02e_トークン管理"
Dim dbs As DAO.Database
Dim rstSource As DAO.Recordset
Dim rstTarget As DAO.Recordset
Dim rstToken As DAO.Recordset
Dim strSQL As String
Dim lngCurrentLineID As Long
Dim strCurrentCode As String
Dim strTokenizedCode As String
Dim lngTokenCounter As Long
Dim lngProcessedCount As Long
' カレントデータベースを取得
Set dbs = CurrentDb
' トークンカウンターを初期化
lngTokenCounter = 0
lngProcessedCount = 0
' 既存データをクリア
dbs.Execute "DELETE FROM " & C_TABLE_TARGET
dbs.Execute "DELETE FROM " & C_TABLE_TOKEN
' レコードセットを開く
strSQL = ""
strSQL = strSQL & "SELECT * FROM " & C_TABLE_SOURCE
strSQL = strSQL & " ORDER BY 連結コードラインID"
Set rstSource = dbs.OpenRecordset(strSQL)
Set rstTarget = dbs.OpenRecordset(C_TABLE_TARGET)
Set rstToken = dbs.OpenRecordset(C_TABLE_TOKEN)
' 各レコードを処理
Do Until rstSource.EOF
lngCurrentLineID = rstSource!連結コードラインID
strCurrentCode = Nz(rstSource!連結コード, "")
' コメントトークン化処理
strTokenizedCode = fnctokenizeコメント(strCurrentCode, _
lngCurrentLineID, _
lngTokenCounter, _
rstToken)
' t02d_トークン化テーブルにレコード追加
rstTarget.AddNew
rstTarget!連結コードラインID = lngCurrentLineID
rstTarget!トークン化コード = strTokenizedCode
rstTarget.Update
lngProcessedCount = lngProcessedCount + 1
rstSource.MoveNext
Loop
' リソース解放
rstSource.Close
rstTarget.Close
rstToken.Close
Set rstSource = Nothing
Set rstTarget = Nothing
Set rstToken = Nothing
Set dbs = Nothing
MsgBox "コメントトークン化処理が完了しました。" & vbCrLf & _
"処理件数: " & lngProcessedCount & vbCrLf & _
"トークン数: " & lngTokenCounter, vbInformation
End Sub
'--------------------------------------------------
'プロシージャの概要:
'処理名:コメントトークン化関数
'概要:1行のコードからコメント部分を検出してトークンに置換する
'strCode:処理対象のコード行
'lngLineID:元の連結コードラインID
'lngTokenCounter:トークンカウンター（参照渡し）
'rstToken:トークン管理テーブルのレコードセット
'戻り値:トークン化されたコード
'--------------------------------------------------
Private Function fnctokenizeコメント(strCode As String, lngLineID As Long, _
ByRef lngTokenCounter As Long, _
ByRef rstToken As DAO.Recordset) As String
Dim strResult As String
Dim intCommentPos As Integer
Dim strCommentPart As String
Dim strCodePart As String
Dim strTokenName As String
Dim blnInString As Boolean
Dim i As Integer
strResult = strCode
' 文字列リテラル内のシングルクォートを考慮してコメント位置を検索
' 【重要】文字列内の'はコメントではないため、ダブルクォートの内外を判定しながら処理する
' 例："Don't worry" ' これはコメント
' ↑この'はコメントではない ↑この'がコメント開始位置
blnInString = False
For i = 1 To Len(strCode)
If Mid(strCode, i, 1) = Chr(34) Then ' ダブルクォート（"）を検出
' 文字列の開始/終了を切り替え
blnInString = Not blnInString
ElseIf Mid(strCode, i, 1) = "'" And Not blnInString Then
' シングルクォート（'）かつ文字列外の場合のみコメント開始と判定
intCommentPos = i
Exit For
End If
Next i
' コメントが見つかった場合
If intCommentPos > 0 Then
' コード部分とコメント部分を分離
strCodePart = Trim(Left(strCode, intCommentPos - 1))
strCommentPart = Mid(strCode, intCommentPos)
' トークン名を生成
lngTokenCounter = lngTokenCounter + 1
strTokenName = "@cmt" & lngTokenCounter
' トークン管理テーブルにレコード追加
rstToken.AddNew
rstToken!トークンID = lngTokenCounter
rstToken!元連結コードラインID = lngLineID
rstToken!トークン文字列 = strTokenName
rstToken!元コメント内容 = strCommentPart
' コメント種別を判定
If Len(strCodePart) > 0 Then
rstToken!コメント種別 = "行末コメント"
Else
rstToken!コメント種別 = "単独行コメント"
End If
rstToken.Update
' トークン化されたコードを作成
If Len(strCodePart) > 0 Then
strResult = strCodePart & " " & strTokenName
Else
strResult = strTokenName
End If
End If
fnctokenizeコメント = strResult
End Function
Excel