VBAで2つのシートの結合、マクロ実行前のパスワード認証などを実装した

講師の情報を検索できるシステムを作っています。前回はExcel上のデータを検索したり一覧表示するシステムを作りました。今回はGoogleスプレッドシートから取得したデータの更新、取得してきたテーブルと名簿の結合、実行前にパスワード認証させるという3つのことをまとめていきます。

レポジトリはこちら。

1. コード全体

1-1. 実行前のパスワード認証、Power Queryのデータの更新、名簿とデータの結合

1-2. パスワード認証のUserForm

2. パスワード認証の仕方

2-1. 認証の判定を代入する変数の準備

データの更新、テーブルの結合の前にパスワード認証を行うことで管理者以外がそれらを行うことを防止しています。

パスワード認証と言っても高度なセキュリティを持ったシステムではなく、単に入力された文字列がパスワードとして予め決めてある文字列と一致するかを判定するだけです。そのため、マクロのコードを覗かれるとパスワードが分かってしまうので注意です。調べたところ、コード自体に保護を掛ける機能がエディターにあるそうです。

さて、まず最初に標準モジュールを挿入し、一番最初の行にパブリック変数を宣言します。

Public passwordResult As Boolean

パブリック変数で宣言した変数は、全てのモジュール内の全てのプロシージャで使用できます。今回はパスワード認証のユーザフォームから判定情報を受け取りたいので、判定情報を代入する変数だけパブリック変数にしています。

2-2. パスワード認証のユーザフォームの作成

次にパスワード認証のユーザフォームを作成します。次の画像のようなユーザフォームを作成することにします。

確認ボタンをクリックすると判定されます。判定をするコードは次の通りです。このコードはVBAでパスワード入力フォームを作ってみました|Excel VBAを参考に作っています。

 Dim myMsg As Integer
 If TextBox1.Value = "password" Then
     myMsg = MsgBox("認証しました", vbOKOnly)
     passwordResult = True
     Unload Me
 Else
     myMsg = MsgBox("認証できませんでした", _
     vbOKOnly + vbInformation, "パスワード認証")

     With TextBox1
         .Value = ""
         .SetFocus
     End With
 End If

パスワードが正しいか判定する部分は次の場所です。

If TextBox1.Value = "password" Then
End If

ダブルクォーテーションマークのところが設定するパスワードです。少し分かりづらいので、パスフレーズを代入しておく変数を用意しておき、その変数と比較させる書き方のほうが良かったと思います。

パスワードが正しいならば、”認証しました”と表示されるポップアップを表示します。ポップアップのOKボタンがクリックされると先程パブリック変数で宣言した変数にTrueが代入され、更に自動的にパスワード認証のウィンドウも消えるようにするためにUnloadさせます。

Unload Me

Unloadステートメントはオブジェクトをアンロード時にメモリから削除し、そのオブジェクトに関連付けられていた全てのメモリを解放します。

Meキーワードは、キーワードで参照しているそのものを示します。今回はUserForm2自体を示します。

パスワードが正しくないとき、”認証できませんでした”とポップアップを表示します。そしてOKボタンがクリックされると、先程のパスワード認証ウィンドウのテキストボックスを初期化し、テキストボックスを入力状態にします。

With TextBox1
    .Value = ""
    .SetFocus
End With

テキストボックスを入力状態にするとき、SetForcusメソッドを利用します。

2-3. 処理の継続/終了の判定を行う

最後に、一番最初に作ったモジュール内でこのパスワード認証のユーザフォームを呼び出します。そして、判定を受け取り、それによって処理を継続/終了の判定を行います。

Private Sub password()
    passwordResult = False
    UserForm2.Show
    If passwordResult = False Then
        End
    End If
End Sub

呼び出す前にパスワード認証の判定を代入する変数をFalseに初期化しておきます。そしてパスワード認証のユーザフォームを呼び出します。パスワード認証のユーザフォームで失敗またはキャンセルを押した場合は変数はFalseが代入されているので、Endステートメントを用いてマクロの実行を終了させます。パスワード認証に成功している場合は何も処理をせず次の処理に移ります。

3. Power Queryで取得したデータの更新

調べてもやり方が出てこなかったので、Excelの”マクロの記録”機能を使ってマクロを作成しました。しかし、万が一取得したテーブルが存在しないことを考えて、テーブルの存在判定を付け加えました。

 With Worksheets("data")
    If .ListObjects.Count = 0 Then
        'テーブルがない場合はエラーメッセージを出す'
         MsgBox "データが存在しません。マニュアルに沿って再接続してください。"
         End
    Else
         'テーブルが存在する場合は更新する'
          ActiveWorkbook.Connections("クエリ - toExcel (6)").Refresh
    End If
End With

“data”という名前のシートにテーブルがあるか判定します。このときWorksheetオブジェクトのListObjects.Countプロパティを用います。

値が0ならばテーブルが存在しないのでエラーを表示します。

値が0でないならば、WorkbookConnection.Refreshメソッドを用いてテーブルを更新します。

4. テーブルと名簿の結合

テーブルに列を挿入して、その列に情報を書き込みます。このとき、テーブルのデータの中で更新された行と新しく追加された行で処理を分けるのがとても面倒くさいので、次のように実装しました。

前提:

結合前のテーブルをdataTable、名簿をmeiboSheet、結合後のシートの名前をmergedSheetと名付けます。

meiboSheetには講師番号、名前、電話番号がこの順番で記載されており、mergedSheetには講師番号、各科目の可能/不可能の情報がこの順番で記載されています。

手順:

1. mergedSheet内の使われているセルの情報を全て削除する
2. dataTabeをmergedSheetにコピーする
3. mergedSheetのB列、C列に列を挿入する
4. “B1″セルと”C1″セルにそれぞれ”名前”、”電話番号”という文字列を代入する
5. meiboSheetの2行目から順番に講師番号を取り出し、mergedSheet内を検索する
6. 見つかった場合、meiboSheetの該当の行のB列、C列のセルの値をmergedSheetの検索している行のB列、C列のセルにそれぞれコピーする
7. これをmeiboSheetの最終行まで繰り返す

コードは以下の通り。

'名簿とデータを結合させる'
Private Sub margeData()
    Dim spreadsheetData        'スプレッドシートから得たデータとsarchableシートのデータ'
    Dim meiboData               '名簿のデータ'
    Dim lastRow, lastColumn     '最終行、最終列'
    Dim i As Long               'For文のindex用'
    Dim resultRg As Range       '検索結果のRangeオブジェクト用'

    'スプレッドシートから得たデータをsarchableにコピー'
    Set spreadsheetData = Worksheets("data").UsedRange
    'sarchableシート全体のセルをクリア'
    Worksheets("sarchable").UsedRange.ClearContents
    'データをコピー'
    spreadsheetData.Copy Destination:=Worksheets("sarchable").Range("A1")
    With Worksheets("sarchable")
        'B,C列を挿入する(講師番号と電話番号が入る)'
        .Columns("B:C").Insert
        'B1とC1に列の名前を入れる'
        .Range("B1").Value = "名前"
        .Range("C1").Value = "電話番号"
    End With

    '名簿のデータをRangeオブジェクトとして取得'
    With Worksheets("meibo").UsedRange
        lastRow = .Cells(Rows.Count, 1).End(xlUp).Row    '最終行の取得'
        lastColumn = .Cells(1, Columns.Count).End(xlToLeft).Column '最終列の取得'
        meiboData = .Range(.Cells(2, 1), .Cells(lastRow, lastColumn)).Value  '最終行までデータを取得する'
    End With

    'sarchableシートの講師番号を講師名簿から検索し、名前と電話番号を入れる'
    With Worksheets("sarchable")
        '電話番号の列の形式を文字列にする'
        .UsedRange.Columns("B:C").NumberFormatLocal = "@"
        '講師番号を講師名簿から検索する'
        For i = LBound(meiboData) To UBound(meiboData)
            Set resultRg = .UsedRange.Columns(1).Find(meiboData(i, 1), LookIn:=xlValues)
            '見つかればsarchableデータのB列とC列にデータを書き込む'
            If Not resultRg Is Nothing Then
                '名前を書き込む'
                .Cells(resultRg.Row, 2).Value = meiboData(i, 2)
                '電話番号を文字列として書き込む'
                .Cells(resultRg.Row, 3).Value = meiboData(i, 3)
            End If
        Next i
    End With
End Sub

4-1. シート全体をクリア

Range.ClearContentsメソッドを利用します。また、使用しているセルの範囲を表すRangeオブジェクトを返すWorksheet.UsedRangeプロパティを用いることで、シート内の使用しているセルの範囲を取得しています。

'sarchableシート全体のセルをクリア'
Worksheets("sarchable").UsedRange.ClearContents

4-2. シート内のデータを別のシートにコピー

Range.Copyメソッドを利用します。

'スプレッドシートから得たデータをsarchableにコピー'
Set spreadsheetData = Worksheets("data").UsedRange
'データをコピー'
spreadsheetData.Copy Destination:=Worksheets("sarchable").Range("A1")

spreadsheetDataがコピー元、Destinationがコピー先の範囲を表します。Destinationの後ろについているのは名前付き引数というものです。

オブジェクト ライブラリで事前に名前が定義されている引数。 名前付き引数を使用すると、構文によって予期される指定された順序で各引数の値を提供する代わりに、任意の順序で値を割り当てることができます。

(名前付き引数より)

4-3. 列の挿入

Range.Insertメソッドを利用します。

4-4. 名簿内を検索し、該当の情報をコピーする

 'sarchableシートの講師番号を講師名簿から検索し、名前と電話番号を入れる'
With Worksheets("sarchable")
    '電話番号の列の形式を文字列にする'
    .UsedRange.Columns("B:C").NumberFormatLocal = "@"
    '講師番号を講師名簿から検索する'
    For i = LBound(meiboData) To UBound(meiboData)
        Set resultRg = .UsedRange.Columns(1).Find(meiboData(i, 1), LookIn:=xlValues)
         '見つかればsarchableデータのB列とC列にデータを書き込む'
        If Not resultRg Is Nothing Then
            '名前を書き込む'
            .Cells(resultRg.Row, 2).Value = meiboData(i, 2)
            '電話番号を文字列として書き込む'
            .Cells(resultRg.Row, 3).Value = meiboData(i, 3)
         End If
     Next i
End With

電話番号をそのままコピーすると文字列として扱われなかったので、B列とC列の書式を文字列に設定しています。セルの書式を文字列に設定するときにRange.NumberFormatプロパティを利用します。

検索にはRange.Findメソッドを利用します。今回は検索対象がA列なので、Rangeオブジェクトをシートの使用範囲の1列目に設定しています。

Set resultRg = .UsedRange.Columns(1).Find(meiboData(i, 1), LookIn:=xlValues)

発見できた場合、その行の2列目と3列目のデータをコピーします。このとき、発見した行を得る必要がありますが、Range.Findメソッドの戻り値はRangeオブジェクトであるため、Range.Rowsプロパティを用いています。

5. おわりに

VBAを書くことに慣れてきたので、これらは結構すんなりと実装できました。

本番環境(バイト先のPC)でマクロが動くかテストしてみたところ、検索システムは動きましたが、Power Queryの更新の部分で引っかかりました。原因は私が開発で使っているExcelのバージョンとバイト先のPCのExcelのバージョンが違うこと。私の開発環境はOffice 365の最新に近いバージョン、一方でバイト先はExcel2016を使っていました。

そのため、更新部分はバイト先でデバッグする必要があります。

とても面倒くさい。

6. 参考文献

• VBAでパスワード入力フォームを作ってみました|Excel VBA
• 変数を宣言する
• Unloadステートメント
• SetForcusメソッド
• Endステートメント
• ListObjectオブジェクト
• WorkSheetオブジェクト
• WorkbookConnection.Refreshメソッド
• Range.ClearContentsメソッド
• 【VBA】簡単かつ高速でシート全体を別ブックの別シートにコピーする
• Worksheet.UsedRangeプロパティ
• Range.Copyメソッド
• 名前付き引数
• Range.Insertメソッド
• Range.NumberFormatプロパティ
• VBA セルに表示形式を設定する
• Range.Rowsプロパティ
• Range.Findメソッド