VBA：SQL日英相互変換

Gemini先生、すばらしい。今回のマクロのソースを「このコードの取扱説明書を日本語で書いて」の一文を添えて貼り付けたら説明書を書いてくれたし。

で、下準備だ。

マクロ対応ブック(.xlsm)に"DBDIC"というシートを作成し、エンティティ定義書やテーブル項目定義書を基に"DBDIC"というテーブルを作れし。項目名、項目IDは正規化しろし。テーブル名と項目名の対応は管理せずそれぞれ個別の辞書を作っている。

セル範囲はどこでもいいが、３，４，６，７カラムにテーブル英名、テーブル日名、項目英名、項目日名が入った表を作れし。カラム位置や並び順を変えたいならMakeDICマクロを修正しろし。
表を範囲選択し、CTRL+Tを押せば、テーブルが作成される。

[テーブルデザイン]－[テーブル名]を”DBDIC"に変更。

VBAエディタから「メニュー追加」を実行すりゃ準備完了。

別のシートを適当に作成し、仕様書から日本語SQLを張り付けたりSQLコードを貼り付け、セル範囲選択し、右クリックメニューから「SQL日英」「SQL英日」「取り消し線文字排除」を実行しろし。クリップボードに結果が転送される。

※下図、whear->where な。面倒だから直さん。

SQLCONV.BAS

Dim ITMENKN As Object Dim ITMKNEN As Object Dim TBLENKN As Object Dim TBLKNEN As Object Public Sub メニュー追加() Call addRightMenu("SQL日英") Call addRightMenu("SQL英日") Call addRightMenu("取消線文字排除コピー") End Sub Sub メニュー削除索() Call delRightMenu("SQL日英") Call delRightMenu("SQL英日") Call delRightMenu("取消線文字排除コピー") End Sub Public Sub addRightMenu(関数名 As String, Optional sShortcut As String = "") Dim Newb As CommandBarControl For Each c In CommandBars If (c.Controls.Count > 0) Then If c.Name = "Cell" Or c.Name = "List Range Popup" Then For i = c.Controls.Count To 1 Step 1 If c.Controls(i).BeginGroup = dalse Then If c.Controls(i).Caption = sShortcut & 関数名 Then c.Controls(i).Delete Else If c.Controls(i).Caption = 関数名 Then c.Controls(i).Delete Else If c.Controls(i).Caption = 関数名 & Shortcut Then c.Controls(i).Delete End If End If End If End If Next Set Newb = c.Controls.Add() Newb.Caption = sShortcut & 関数名 Newb.OnAction = 関数名 Else For i = c.Controls.Count To 1 Step -1 If c.Controls(i).BeginGroup = dalse Then If InStr(c.Controls(i).Caption, "書式設定") > 0 Or _ InStr(c.Controls(i).Caption, "図として") > 0 Then End If End If Next End If End If Next End Sub Public Sub delRightMenu(関数名 As String, Optional sShortout As String = "") Dim Newb As CommandBarControl Debug.Print CommandBars.Count For Each c In CommandBars If (c.Controls.Count > 0) Then If c.Name "Cell" Or c.Name = "List Range Popup" Then Debug.Print c.NameLocal & " : " & c.Name For i = c.Controls.Count To 1 Step -1 If c.Controls(i).BeginGroup = dalse Then Debug.Print " " & c.Controls(i).Caption If c.Controls(i).captions = Shortout & 関数名 Then c.Controls(i).Delete End If End If Next End If End If Next End Sub Sub MakeDIC() Dim lo As ListObject Dim T3, T4, T6, T7 As String Set sh = ActiveSheet Sheets("DBDIC").Activate Set ITMENKN = CreateObject("Scripting.Dictionary") Set ITMKNEN = CreateObject("Scripting.Dictionary") Set TBLENKN = CreateObject("Scripting.Dictionary") Set TBLKNEN = CreateObject("Scripting.Dictionary") For Each cel In ActiveSheet.ListObjects("DBDIC").ListRows T3 = LCase(StrConv(cel.Range.Cells(3).Text, vbNarrow)) T4 = StrConv(cel.Range.Cells(4).Text, vbWide) T6 = LCase(StrConv(cel.Range.Cells(6).Text, vbNarrow)) T7 = StrConv(cel.Range.Cells(7).Text, vbWide) If Not (TBLENKN.exists(T3)) Then TBLENKN.Add T3, T4 TBLKNEN.Add T4, T3 End If If Not (ITMENKN.exists(T6)) Then ITMENKN.Add T6, T7 ITMKNEN.Add T7, T6 Debug.Print ITMENKN.Item(T6) End If Next sh.Activate End Sub Public Function GetRealText() Dim cel As Object Dim sep As String For i = 1 To Selection.Cells.Count DoEvents Set cel = Selection.Cells(i) If cel.Column <> Selection.Cells(Selection.Cells.Count).Column Then sep = Chr(9) Else sep = Chr(10) End If If cel.Text <> "" Then If cel.Font.Strikethrough Then Else If cel.Text <> cel.Formula Then GetRealText = GetRealText & cel.Text Else On Error GoTo 10 k = cel.Characters.Count For j = 1 To cel.Characters.Count If cel.Characters(j, 1).Font.Strikethrough Then Else GetRealText = GetRealText & cel.Characters(j, 1).Caption End If Next 20 End If End If End If GetRealText = GetRealText & sep Next Exit Function 10 GetRealText = GetRealText & cel.Text Resume 20 End Function Function RegSch(strTarget As String, strPat As String) As Object Dim Matches Dim ret As String Set RE = CreateObject("VBScript.RegExp") With RE .Pattern = strPat .IgnoreCase = True .Global = False End With Set Matches = RE.Execute(strTarget) If Matches.Count = 0 Then Set RegSch = Nothing Else Set RegSch = Matches(0) End If End Function Public Sub SQL日英() Dim sWord As String Dim result As Object Application.StatusBar = "SQL日英:辞書作成" Call MakeDIC Application.StatusBar = "SQL日英:取消線除外中" src = GetRealText() lineStrs = Split(src, Chr(10)) For Each linestr In lineStrs DoEvents nCount = nCount + 1 Application.StatusBar = "SQL日英:" & nCount sWord = linestr Do Set result = RegSch(sWord, "[^\s\t\.\(\)\(\=\-\+\*\<\>\,　．（）（＝－＋＊＜＞，]+") If result Is Nothing Then outtext = outtext & sWord sWord = "" Else outtext = outtext & Left(sWord, result.firstindex) If TBLKNEN.exists(result.Value) Then outtext = outtext & TBLKNEN(result.Value) Else If ITMKNEN.exists(result.Value) Then outtext = outtext & ITMKNEN(result.Value) Else outtext = outtext & result.Value End If End If sWord = Right(sWord, Len(sWord) - result.Length - result.firstindex) End If Loop While (Len(sWord) > 0) Debug.Print linestr outtext = outtext & Chr(10) Next With CreateObject("Forms.TextBox.1") .MultiLine = True .Text = outtext .SelStart = 0 .SelLength = .TextLength .Copy End With Application.StatusBar = "" End Sub Public Sub SQL英日() Dim sWord As String Dim result As Object Application.StatusBar = "SQL英日:辞書作成" Call MakeDIC Application.StatusBar = "SQL英日:取消線除外中" src = GetRealText() lineStrs = Split(src, Chr(10)) For Each linestr In lineStrs DoEvents nCount = nCount + 1 Application.StatusBar = "SQL英日:" & nCount sWord = linestr Do Set result = RegSch(sWord, "[^\s\t\.\(\)\(\=\-\+\*\<\>\,　．（）（＝－＋＊＜＞，]+") If result Is Nothing Then outtext = outtext & sWord sWord = "" Else outtext = outtext & Left(sWord, result.firstindex) If TBLENKN.exists(LCase(result.Value)) Then outtext = outtext & TBLENKN(LCase(result.Value)) Else If ITMENKN.exists(LCase(result.Value)) Then outtext = outtext & ITMENKN(LCase(result.Value)) Else outtext = outtext & result.Value End If End If sWord = Right(sWord, Len(sWord) - result.Length - result.firstindex) End If Loop While (Len(sWord) > 0) Debug.Print linestr outtext = outtext & Chr(10) Next With CreateObject("Forms.TextBox.1") .MultiLine = True .Text = outtext .SelStart = 0 .SelLength = .TextLength .Copy End With Application.StatusBar = "" End Sub Public Sub 取消線文字排除コピー() Dim outtext As String outtext = GetRealText() With CreateObject("Forms.TextBox.1") .MultiLine = True .Text = outtext .SelStart = 0 .SelLength = .TextLength .Copy End With End Sub

以下、Gemini先生の説明だ。日英と英日を取り違えてるのは御愛嬌だ。

このマクロは、主に以下の機能を提供します。

このコードの取扱説明書 (This code's manual)

このマクロは、主に以下の機能を提供します。

• メニューの追加と削除
  「SQL日英」や「SQL英日」などのメニューを Excel の右クリックメニューに追加したり削除したりできます。
• 辞書の作成
  あらかじめ用意されたシート ("DBDIC") から、日英変換用の辞書を作成します。
• 取消線文字を除外したコピー
  選択範囲のセルにあるテキストをコピーしますが、取り消し線が付いている文字は除外されます。
• SQL文の変換
  「SQL日英」メニューを選択すると、選択範囲の英字を日本語に変換します。逆に「SQL英日」メニューを選択すると、日本語を英字に変換します。変換には、あらかじめ作成した辞書が使用されます。

使い方

1. このコードを VBA エディタに貼り付けます。
2. 必要に応じて、シート "DBDIC" の内容を変更します (日英変換用の辞書データです)。
3. マクロを実行したいセルまたはシート上で、右クリックメニューから追加したメニューを選択します。

注意

• このマクロは、作成されたシート ("DBDIC") を前提としています。このシートの内容を変更したり削除したりすると、マクロが正しく動作しなくなる可能性があります。