覚えておきたいExcelの使い方

• １つのセルに入力できる最大文字数は 32767 文字までだが、「セルの書式設定」が「文字列」の場合 255 文字しか入らない
• 「セルの書式設定」でインデントを設定することができる。
• 「B1:B1000」としなくても「B:B」とするとBの縦列を範囲指定できる。
• 「Alt」＋「F11」でVBA起動
• WinMegeでExcelファイル同士の差分比較を見ることが出来る。（2つのファイルをWinMergeで開き。画面下部の「展開プラグイン」で開く。v2.0以降？）

覚えておきたいVBAの使い方

• 「<>」は「!=」と同じ比較演算子。
• 「:」は複数処理をコロン区切りで1行に記述できる。
• 「_」でコードを改行することができる。
• イミディエイトウインドウではワンライナーでしか実行できない。
• イミディエイトウインドウでは「Dim」を使った変数定義はできない。
• 改行コードについて
• 「\r」（Cr）は「Chr(13)」、「vbCr」
• 「\n」（Lf）は「Chr(10)」、「vbLf」
• 「\r\n」（CrLf）は「Chr(13) & Chr(10)」、「vbCrLf」

アドインの入れ方

1. 作成したマクロを「tool.xla」で保存し「%APPDATA%\Microsoft\AddIns」に配置する。
2. ［開発］タブの［アドイン］をクリックし「tool.xla」にチェックを入れる。
3. ［ファイル］タブから［オプション］を選択する。
4. ［クイックアクセスツールバー］の［コマンドの選択］のプルダウンメニューから［マクロ］を選択
5. 右側に新規のタブを追加。その子要素にグループを追加する。
6. 選択した［マクロ］を追加

便利マクロ

全シート名一覧を取得

For Each i In ThisWorkbook.Sheets: debug.print i.name : next i

全シートの図形の文字列置換

For Each Sha In ActiveSheet.Shapes: Sha.TextFrame.Characters.Text = Replace(Sha.TextFrame.Characters.Text, "契約情報CSV", "契約異動情報CSV") : Next

全シートのカーソルをセルA1、表示倍率を100%

Sub Cursor_A1()
    Dim ws As Worksheet

    For Each ws In Worksheets
        ws.Select
        Range("A1").Select
        ActiveWindow.Zoom = 100
    Next ws

    Worksheet(1).Select
    MsgBox "全てのシートのカーソルをA1、表示倍率を100%にしました"

End Sub

選択範囲のセルを縦・横に処理する

Dim i As Integer
Dim rownum As Integer
Dim colnum As Integer

' 縦に処理する
For i = 0 To Selection.Rows.Count - 1
    rownum = Selection.Row + i
    colnum = Selection.Column
    
    Cells(rownum, colnum).value = rownum & "-" & colnum
    
Next i

' 横に処理する
For i = 0 To Selection.Columns.Count - 1
    rownum = Selection.Row
    colnum = Selection.Column + i
    
    Cells(rownum, colnum).value = rownum & "-" & colnum
    
Next i

SQL文出力ツール

Private Sub UserForm_Initialize()
    Set WScript = CreateObject("WScript.Shell")
    FileTxt.Value = WScript.SpecialFolders("Desktop") & "\" & Format(Now, "yyyymmdd") & ".sql"

End Sub

Private Sub FileBtn_Click()
    FileTxt.Text = Application.GetSaveAsFilename(FileFilter:="sqlファイル, *.sql")
End Sub

Private Sub PutTextBtn_Click()
    Call PutSQL(0, 1)
End Sub

Private Sub PutCellBtn_Click()
    Call PutSQL(1, 0)
End Sub

Private Sub BtnEnd_Click()
    End 'Form終了
End Sub


Private Sub PutSQL(putCellFlg As Integer, putTextFlg As Integer)
'--------------------------------------------------------------------------------
' 関 数 名：SQL文出力
' 処理概要：Excelのテーブル表からSQL文を出力する
' 引  　数：
'   putCellFlg As Integer Excelのテーブル表のセル横にSQL文出力フラグ
'   putTextFlg As Integer テキストファイルにSQL文出力フラグ
' 返 却 値：なし
' ■概要
'   複数シートを選択してSQL文をExcelのテーブル表のセル横に出力する。
'   複数シートを選択してSQL文をテキスト出力する。
'
' ▼前提条件
' ・excelの複数シートのセル「B2」の位置にテーブル名でそろえる。
' ・excelの複数シートのセル「B5」の位置にカラム名でそろえる。
' ・PKEYのカラムをセル「B5」の位置にする。
'
' ▼使い方
' 1. 複数シートを選択する。
' 2. マクロ実行
'
' ▼機能仕様
' ・Excelのテーブル表のセルが「(NULL)」の場合に「NULL」でインサートされる。
' ・Excelのテーブル表のセルが「’’」(空白)の場合は「’’」(空白)でインサートされる。
' ・Excelのテーブル表のセルが日付の場合は、表示のまま文字列(日付)でインサートされる。
' ・Excelのテーブル表のセルが「\」を含む場合はエスケープされる。例：「\r\n」→「\\r\\n」
' ・Excelのテーブル表の列が非表示の場合、そのカラムはSQL出力されない
' ・Excelのテーブル表の行が非表示の場合、そのレコードはSQL出力されない
' ・SQL文出力ファイル名はデフォルトでデスクトップに「yyyymmdd.sql」で出力される。
'--------------------------------------------------------------------------------
On Error GoTo Catch

    'Dim putCellFlg As Integer ' Excelのテーブル表のセル横にSQL文出力フラグ
    'Dim putTextFlg As Integer ' テキストファイルにSQL文出力フラグ
    Dim TextFilePath As String ' 出力するテキストファイルパス
    Dim tableAddress As String ' テーブル名のセル位置
    Dim columnAddress As String ' テーブル.カラムのセル位置
    Dim baseX As Integer ' テーブル.カラムのセル位置X
    Dim baseY As Integer ' テーブル.カラムのセル位置Y
    Dim dataX As Integer ' SQL文出力位置X
    Dim dataY As Integer ' SQL文出力位置Y
    Dim dataIniX As Integer ' SQL文出力の初期位置となる軸X
    Dim putX As Integer ' SQL文出力位置を何マス先に出力するか
    Dim PKEYAddress As String ' PKEYのカラムのセル位置
    Dim PKEYcolumn As String ' PKEYのカラム
    Dim PKEYvalue As String ' PKEYの値
    Dim columnCnt As Integer ' カラム数
    Dim recordCnt As Integer ' 登録件数
    Dim lastX As Integer ' 使用済みカラムの最終列

    Dim errmsg As String ' エラーメッセージ
    Dim sheet As Object ' シート
    Dim str As String ' 文字列処理
    Dim sql As String ' SQL処理
    Dim spr As String ' セパレート（区切り）

    Dim WScript As Object
    Dim fso As Object
    Dim ts As Object

    Dim sqlcontent As String
    Dim tablesTxt As String
    Dim selectCountSql As String
    Dim selectSql As String
    Dim deleteSql As String
    Dim insertSql As String

    Set WScript = CreateObject("WScript.Shell")
    Set fso = CreateObject("Scripting.FileSystemObject")
        
    '--------------------------------------------------------------------------------
    ' 初期値設定
    '--------------------------------------------------------------------------------
    'putCellFlg = 0 ' Excelのテーブル表の右セルにSQL文出力フラグ
    'putTextFlg = 0 ' テキストファイルにSQL文出力フラグ
    TextFilePath = FileTxt.Value '「C:\Users\[username]\Desktop\yyyymmdd.sql」
    tableAddress = TableTxt.Value  ' テーブル名のセル位置
    columnAddress = TableColumnTxt.Value ' テーブル.カラムの初期セル位置
    PKEYAddress = PKEYTxt.Value ' PKEYのカラムのセル位置
    putX = 2 ' SQL文出力位置を何マス目の先に出力するか
    '------------------------------------------------------

    ' バリデーションチェック
    If tableAddress = "" Then
        MsgBox "テーブル名のセル位置を入力してください"
        Exit Sub
    End If

    If columnAddress = "" Then
        MsgBox "テーブル.カラムの位置を入力してください"
        Exit Sub
    End If

    If putTextFlg = 1 Then
        'TxtFile.Text = Application.GetSaveAsFilename(FileFilter:="sqlファイル, *.sql")
        If TextFilePath = "" Then
            MsgBox "SQL出力ファイルを選択してください"
            Exit Sub
        End If
    End If

    sqlcontent = ""

    ' SQL文テキスト冒頭に対象テーブル一覧のコメント
    tablesTxt = ""
    tablesTxt = "--●対象テーブル" & vbCrLf

    selectCountSql = ""

    ' 選択したシートに対して全処理
    For Each sheet In ActiveWindow.SelectedSheets

        selectSql = "" ' select文SQL
        deleteSql = "" ' delete文SQL
        insertSql = "" ' insert文SQL

        sheet.Activate ' シート選択

        If PKEYAddress = "" Then
            PKEYAddress = columnAddress
        End If

        baseX = Range(columnAddress).Column ' テーブル.カラムのセル位置X
        baseY = Range(columnAddress).Row ' テーブル.カラムのセル位置Y

        recordCnt = Cells(Rows.Count, baseX).End(xlUp).Row - baseY
        columnCnt = Cells(baseY, Columns.Count).End(xlToLeft).Column - (baseX - 1)

        lastX = sheet.UsedRange.Columns.Count ' 使用済みカラムの最終列

        dataIniX = lastX + putX ' データ出力初期位置X

        ' SQL文テキスト冒頭に対象テーブル一覧のコメント
        tablesTxt = tablesTxt & "--" & Range(tableAddress).Value & vbCrLf

        ' SQL文テキスト冒頭にカウント
        selectCountSql = selectCountSql & "select count(*) from " & Range(tableAddress).Value & ";" & vbCrLf

        For i = 1 To recordCnt Step 1

            dataX = dataIniX ' データ出力位置X
            dataY = baseY + i ' データ出力位置Y

            ' 非表示レコード対応
            If Cells(dataY, dataX).Rows.Hidden = False Then

                PKEYcolumn = Range(PKEYAddress).Value
                PKEYvalue = Cells(dataY, Range(PKEYAddress).Column).Value

                If InStr(PKEYvalue, "(NULL)") Then
                    PKEYvalue = "NULL"
                End If

                '-----select文作成-----
                sql = ""
                sql = sql & "select * from " & Range(tableAddress).Value
                sql = sql & " where " & PKEYcolumn & " = " & PKEYvalue & ";"
                selectSql = selectSql & sql & vbCrLf
                If putCellFlg = 1 Then
                    Cells(dataY, dataX) = sql
                End If

                '-----delte文作成-----
                dataX = dataX + 1
                sql = ""
                sql = sql & "delete from " & Range(tableAddress).Value
                sql = sql & " where " & PKEYcolumn & " = " & PKEYvalue & ";"
                deleteSql = deleteSql & sql & vbCrLf
                If putCellFlg = 1 Then
                    Cells(dataY, dataX) = sql
                End If

                '-----insert文作成（カラム）-----
                dataX = dataX + 1
                sql = ""
                sql = sql & "insert into " & Range(tableAddress).Value & " ("

                spr = ""
                For x1 = 0 To columnCnt - 1 Step 1

                    If Cells(baseY, baseX + x1).Columns.Hidden = False Then

                        sql = sql & spr & Cells(baseY, baseX + x1).Value
                        spr = ","

                    End If
                Next

                sql = sql & " ) values ("

                '-----insert文作成（値）-----
                spr = ""
                For x2 = 0 To columnCnt - 1 Step 1

                    If Cells(baseY, baseX + x2).Columns.Hidden = False Then

                        str = ""
                        str = "'" & Cells(dataY, baseX + x2).Value & "'"

                        If InStr(1, str, "(NULL)", vbTextCompare) Then
                            str = "NULL"
                        End If
                        
                        str = Replace(str, "\", "\\", 1, -1) ' エスケープはすべて置換する

                        sql = sql & spr & str
                        spr = ","

                    End If

                Next

                sql = sql & ");"
                insertSql = insertSql & sql & vbCrLf
                If putCellFlg = 1 Then
                    Cells(dataY, dataX) = sql
                    Cells(dataY, dataX + 1) = " " ' 次のセルに全角空白でSQL文を見やすく
                End If

            End If

        Next

        ' sqlテキスト出力対応
        If putTextFlg = 1 Then

            sqlcontent = sqlcontent & "--●" & sheet.Name & vbCrLf
            If SelectChk.Value Then
                sqlcontent = sqlcontent & selectSql & vbCrLf
            End If
            If InsertChk.Value Then
                sqlcontent = sqlcontent & insertSql & vbCrLf
            End If
            If DeleteChk.Value Then
                sqlcontent = sqlcontent & deleteSql & vbCrLf
            End If

        End If

    Next

    If putTextFlg = 1 Then

        Set ts = fso.OpenTextFile(TextFilePath, 2, True, 0) ' ファイルを Shift-JIS で開く

        ts.WriteLine (tablesTxt)
        ts.WriteLine (selectCountSql)
        ts.WriteLine (sqlcontent)
        ts.WriteLine (selectCountSql)

        ts.Close

        ' 後始末
        Set ts = Nothing
        Set fso = Nothing

    End If

    MsgBox "SQL文出力処理が終了しました"
    ActiveSheet.Select
    End ' Form終了

Catch: ' エラーが発生したときはこの後から処理を行います

    errmsg = ""
    Select Case Err.Number
        Case 70
        errmsg = "ファイルが開かれているため書き込みできません。" & vbCrLf
    
    End Select
    
    errmsg = errmsg & vbCrLf
    errmsg = errmsg & "エラー発生アプリ: " & Err.Source & vbCrLf
    errmsg = errmsg & "エラー番号: " & Err.Number & vbCrLf
    errmsg = errmsg & "エラー内容: " & Err.Description & vbCrLf
    MsgBox errmsg
End Sub