EecelでSQLを見やすく

テキストエディタでSQLを強調表示でみればいいじゃん
とは言わないで・・・

Excelで資料まとめたりで見たいときあるじゃない・・・

完成品とは言えないけども・・・
ちょっと作ってみました。

SQL拝借させていただきます。
http://logicalerror.seesaa.net/article/225234014.html


借りたSQLをExcelに貼り付け。

作ったマクロを実行

多少は見やすくなりましたかね・・・？


以下ソース
Sub sqlmojicolor()
ActiveWorkbook.Save
Dim re, mc, m, r As Range, endp, str, myArray() As String
Dim i As Variant

On Error Resume Next
    Set DataRng = Application.InputBox( _
        "・セル範囲は連続していなくても構いません", "データ範囲を指定します", Type:=8)
    If DataRng Is Nothing Then Exit Sub
    On Error GoTo 0

'画面更新停止
Application.ScreenUpdating = False

'予約文字
str = "off,transaction,databasepassword,top,current_user,current_timestamp,current_time,current_date,intersect,setuser,inner,index,identitycol,having,rowcount,collate,holdlock,rowguidcol,column,identity,rule,commit,identity_insert,save,compute,schema,constraint,if,contains,in,session_user,containstable,set,continue,convert,insert,shutdown,count,some,into,statistics,cross,sum,current,join,system_user,key,table,kill,textsize,left,then,like,to,cursor,lineno,database,load,tran,max,dateadd,min,trigger,datediff,national,truncate,datename,nocheck,tsequal,datepart,nonclustered,union,dbcc,not,bigint,binary,bit,char,date,datetime,datetime2,datetimeoffset,decimal,float,geography,geometry,hierarchyid,image,int,money,nchar,ntext,numeric,nvarchar,real,smalldatetime,smallint,smallmoney,sql_variant,sysname,text,time,timestamp,tinyint,uniqueidentifier,varbinary,varchar,xml" & _
      "unique,deallocate,null,update,declare,nullif,updatetext,default,of,use,delete,user,deny,offsets,values,desc,on,varying,disk,open,view,distinct,opendatasource,waitfor,distributed,openquery,when,double,openrowset,where,drop,openxml,while,dump,option,with,else,writetext,procedure,asc,execute,@@identity,encryption,order,add,end,outer,all,errlvl,over,alter,escape,percent,and,except,plan,any,exec,precision,as,primary,exists,print,authorization,exit,proc,avg,expression,backup,fetch,public,file,raiserror,between,fillfac,from,group by,case,select,nvl,begin,exception,others,create,or,replace,package,end;,is,integer,false,true,length,trim,rtrim,raise,rollback;,constant,sysdate;,immediate,substr,to_char,varchar2,return"
    
'配列変換
myArray = Split(str, ",")

'ループ１
Set re = CreateObject("VBScript.RegExp")
    re.IgnoreCase = True          '大文字と小文字を区別しない
    re.Global = True              '文字列全体検索
For Each i In myArray
    '予約語
    re.Pattern = "[^\w.]" & i & "[^_A-z]" & "|" & "[^\w.]" & i & "$" & "|" & "^" & i & "[^\w.]" & "|" & "^" & i & "$"
    Set r = DataRng.Find("*")
    If r Is Nothing Then End
        endp = r.Address
        Do
            Set mc = re.Execute(r)
            For Each m In mc
            '青
                r.Characters _
                (m.FirstIndex + 1, m.Length).Font.ColorIndex = 5
            Next
            Set r = DataRng.FindNext(r)
        Loop Until r.Address = endp
  Next i

'文字列を赤に
    '文字列
    re.Pattern = "'(.*?)'"
Set r = DataRng.Find("*")
If r Is Nothing Then End
    endp = r.Address
    Do
        Set mc = re.Execute(r)
        For Each m In mc
        '赤
            r.Characters _
            (m.FirstIndex + 1, m.Length).Font.ColorIndex = 3
        Next
        Set r = DataRng.FindNext(r)
    Loop Until r.Address = endp

'(を黒太字に
    '文字列
    re.Pattern = "[()]"
Set r = DataRng.Find("*")
If r Is Nothing Then End
    endp = r.Address
    Do
        Set mc = re.Execute(r)
        For Each m In mc
        '黒
            r.Characters _
            (m.FirstIndex + 1, m.Length).Font.ColorIndex = 1
            r.Characters _
            (m.FirstIndex + 1, m.Length).Font.Bold = True
        Next
        Set r = DataRng.FindNext(r)
    Loop Until r.Address = endp

'--をコメント緑に
    'コメント
    re.Pattern = "[\-]{2}.+|[/][\*].+|.+[\*][/]$"
Set r = DataRng.Find("*")
If r Is Nothing Then End
    endp = r.Address
    Do
        Set mc = re.Execute(r)
        For Each m In mc
        '緑
            r.Characters _
            (m.FirstIndex + 1, m.Length).Font.ColorIndex = 10
        Next
        Set r = DataRng.FindNext(r)
    Loop Until r.Address = endp
Set re = Nothing

'画面更新再開
Application.ScreenUpdating = True

End Sub