OneDrive(SharePoint)の「共同編集」は大変魅力的な機能です。特にオンライン版のエクセルでは、完璧に機能していると思います。
ただし、デスクトップ版のエクセルでは正常に機能しないことも多いようです。特に、VBAを使ったファイルは共同編集できません
さらに、法律事務所の場合、セキュリティ上の観点からOneDrive(SharePoint)上にファイルをそのまま置くことができない場合も多いと思います。(そもそもOneDriveを利用していない場合もあると思います。)
VBAアセットでは、CSVファイルを利用した簡易的なデータベースをエクセルの外部に作って、データをそこに保存できるようにしています。こうすれば、上記のような場合でも、データファイルを安全な領域に保存したうえで共同編集を行うことが可能になります。
CSVファイルを使ったデータ共有の原理
ユーザーがエクセルファイルにデータを入力した際には、そのテーブルのレコード(行)データをレコードファイル(TSVファイル)に書き込みます。(CSVファイルはカンマを区切り文字に使うのが一般的ですが、データに「,」が使われることが考えられるため区切り文字にタブを使ったTSVファイルを使用しています。)
排他性をもたせるため、レコードファイルのファイル名をテーブルのキー列にしています。(図のように「キー」にユーザー名を加えることができば、排他性がより高まります。)
また、テーブルの更新日時とタイムスタンプを比較することで、他の人が変更したデータを上書きする場合はメッセージが表示されるようにしています。(他の人が変更したデータを選択した場合は、レコードファイルの内容をテーブルのレコードに上書きします。)
データの入出力
速度を向上させるため、あらかじめテーブル全体のデータをテーブルファイルに保存しておきます。
その後、テーブルに書き込まれたデータは、レコードごとにレコードファイルに保存します。
レコードファイルの保存時には、他の人が先に修正を加えていないかを確認し、修正が加えられている場合は、テーブルに書き込んだレコードで更新するか、レコードファイルを読み込むかを選択できるようにします。
エクセルを再起動した際には、テーブルファイルとすべてのレコードファイルからデータの読込を行います。
レコードファイルの数が増え、読込に時間がかかるようになってきたら、テーブル全体をテーブルファイルに書込み、すべてのレコードファイルを削除します。
注意:プログラムの制約上、レコードが1つ以下の場合は読込ができません。(対応も可能ですが、実用上は問題ないので放置してあります。)
データ共有マクロ
CSVファイルを利用した外部データベースを使うためには、「WriteRecord」、「ReadRecord」、「WriteTable」および「ReadTable」の4つのプロシージャが必要となります。
WriteRecord
テーブルレコードをレコードファイルに書きこみます。
引数:データベースフォルダ,テーブル名,レコード番号,キー列の数
Sub WriteRecord(strFolder, strTable, r, lngKeys)
'テーブルレコードをレコードファイルに書きこみます。
'エラー処理を設定する
On Error GoTo HdlErr
'ステータスバーを表示する
Application.StatusBar = "レコードファイルに書き込んでいます。"
'ファイル名を把握する
'http://officetanaka.net/excel/vba/function/Join.htm
'https://www.relief.jp/docs/excel-vba-woksheetfunction-textjoin.html
Dim strFile
strFile = WorksheetFunction.TextJoin("_", False, Range(Range(strTable)(r, 1), Range(strTable)(r, lngKeys))) & ".TSV"
'レコードファイルが存在しない場合はスキップする
If Dir(strFolder & "\" & strFile) = "" Then GoTo Continue
'レコードファイルのタイムスタンプがテーブルレコードの更新日時と同一または古い場合はスキップする
If Range(strTable)(r, Range(strTable).Columns.Count) >= FileDateTime(strFolder & "\" & strFile) Then GoTo Continue
'上書きが拒否された場合
If MsgBox("より新しいレコードファイルが存在します。" & vbCr & _
"現在の行データでレコードファイルを上書きしてよろしいですか?", vbYesNo) = vbNo Then
'レコードファイルのデータを読み込む
TSV.ReadRecord strFolder, strTable, r, lngKeys
'終了する
Exit Sub
End If
Continue:
'レコードファイルを出力モードで開く
'ファイルが存在しない場合は新規に作成されます。
Open strFolder & "\" & strFile For Output As #1
'フィールド列の値をタブで区切ってフィールド文字列を生成する
'キー列の次の列から「更新日時」の手前列までのデータを取り込みます。
'http://officetanaka.net/excel/vba/function/Join.htm
'https://www.relief.jp/docs/excel-vba-woksheetfunction-textjoin.html
Dim strField
strField = WorksheetFunction.TextJoin(vbTab, False, _
Range(Range(strTable)(r, lngKeys + 1), Range(strTable)(r, Range(strTable).Columns.Count - 1)))
'フィールド文字列をレコードファイルに書き込む
Print #1, strField
'レコードファイルを閉じる
Close #1
'テーブル行のタイムスタンプを修正する
Range(strTable)(r, Range(strTable).Columns.Count).Value = FileDateTime(strFolder & "\" & strFile)
'ステータスバーを解除する
Application.StatusBar = False
Exit Sub
HdlErr:
'エラーメッセージを表示する
MsgBox strTable & "の" & r & "番目のレコードをレコードファイルに書き込めませんでした。", vbExclamation
'ステータスバーを解除する
Application.StatusBar = False
'すべてのファイルを閉じる
Close
End Sub
ReadRecord
テーブルレコードをレコードファイルから読み込みます。
引数:データベースフォルダ名, テーブル名, レコード番号,キー列の数
Sub ReadRecord(strFolder, strTable, r, lngKeys)
'テーブルレコードをレコードファイルから読み込みます。
'エラー処理を設定する
On Error GoTo HdlErr
'メッセージを表示する
If MsgBox("レコードファイルで現在の行データを上書きしますか?", vbYesNo) = vbNo Then
'処理を終了する
Exit Sub
End If
'ステータスバーを表示する
Application.StatusBar = "レコードファイルを読み込んでいます。"
'ファイル名を把握する
'http://officetanaka.net/excel/vba/function/Join.htm
'https://www.relief.jp/docs/excel-vba-woksheetfunction-textjoin.html
Dim strFile
strFile = WorksheetFunction.TextJoin("_", False, Range(Range(strTable)(r, 1), Range(strTable)(r, lngKeys))) & ".TSV"
'レコードファイルを入力モードで開く
Open strFolder & "\" & strFile For Input As #1
'フィールド文字列を読み込む
Dim strField
Line Input #1, strField
'レコードファイルを閉じる
Close #1
'フィールド文字列をテーブル行に書き込む
'TextSplit関数はVBAでは使用できません。
Range(Range(strTable)(r, lngKeys + 1), Range(strTable)(r, Range(strTable).Columns.Count - 1)) _
= Split(strField, vbTab)
'セルの数値を入力し直す
'これを行わないと数値が文字列のままになります。
Range(strTable).Value = Range(strTable).Value
'タイムスタンプをテーブル行に書き込む
Range(strTable)(r, Range(strTable).Columns.Count) = FileDateTime(strFolder & "\" & strFile)
'ステータスバーを解除する
Application.StatusBar = False
Exit Sub
HdlErr:
'エラーメッセージを表示する
MsgBox strTable & "の" & r & "番目のレコードをレコードファイルから読み込めませんでした。", vbExclamation
'ステータスバーを解除する
Application.StatusBar = False
'すべてのファイルを閉じる
Close
End Sub
WriteTable
テーブル全体をテーブルファイルに書き込んで、レコードファイルを削除します。
引数:データベースフォルダ名,テーブル名,キー列の数
Sub WriteTable(strFolder, strTable, lngKeys)
'テーブル全体をテーブルファイルに書き込んで、レコードファイルを削除します。
'エラー処理を設定する
On Error GoTo HdlErr
'ステータスバーを表示する
Application.StatusBar = "テーブルファイルにデータを書き込んでいます。"
'テーブルファイルを出力モードで開く
'ファイルが存在しない場合は新規に作成されます。
Open strFolder & "\" & "Table.TSV" For Output As #1
'テーブルのすべての行を繰り返す
For r = 1 To Range(strTable).Rows.Count
'テーブルの行の文字列をテーブルファイルに書き込む
'http://officetanaka.net/excel/vba/function/Join.htm
'https://www.relief.jp/docs/excel-vba-woksheetfunction-textjoin.html
Print #1, WorksheetFunction.TextJoin(vbTab, False, _
Range(Range(strTable)(r, 1), Range(strTable)(r, Range(strTable).Columns.Count)))
Next
'テーブルファイルを閉じる
Close #1
'ステータスバーを表示する
Application.StatusBar = "レコードファイルを削除しています。"
'データベース内のファイルを検索する
Dim strFile
strFile = Dir(strFolder & "\" & "*.TSV")
'ファイルが存在する間
Do While strFile <> ""
'ファイルがテーブルファイルでなく、コピーファイルでもない場合
If strFile <> "Table.TSV" And InStr(strFile, "(") = 0 Then
'ファイルを削除する
Kill strFolder & "\" & strFile
End If
'次のファイルを読み込む
strFile = Dir()
Loop
'ステータスバーを解除する
Application.StatusBar = False
Exit Sub
HdlErr:
'エラーメッセージを表示する
MsgBox "テーブルからデータベースへの書き込みができませんでした。", vbExclamation
'ステータスバーを解除する
Application.StatusBar = False
'すべてのファイルを閉じる
Close
End Sub
ReadTable
データベースから全てのデータを読み込んでテーブルを書き換えます。
引数:データベースフォルダ名,テーブル名,キー列の数
Sub ReadTable(strFolder, strTable, lngKeys)
'データベースから全てのデータを読み込んでテーブルを書き換えます。
'エラー処理を設定する
On Error GoTo HdlErr
'ステータスバーを表示する
Application.StatusBar = "テーブルのデータを削除しています。"
'テーブルにデータがあれば削除する
'データを削除しても書式は残ります。
If WorksheetFunction.CountA(Range(strTable)) <> 0 Then Range(strTable).Delete
'テーブルの書式を解除する
'書き込み速度を向上させるための処理です
Range(strTable).ClearFormats
'ステータスバーを表示する
Application.StatusBar = "テーブルファイルを読み込んでいます。"
'テーブルファイルを開く
Open strFolder & "\" & "Table.TSV" For Input As #1
'テーブルファイルの終端まで繰り返す
i = 0
Do Until EOF(1)
'ライン文字列を読み込む
'http://officetanaka.net/excel/vba/file/file08b.htm
Dim strLine
Line Input #1, strLine
'ライン文字列をライン配列に書き込む
'https://daitaideit.com/vba-char-split/
Dim arrLine
arrLine = Split(strLine, vbTab)
'ライン配列をテーブル配列に追加する
Dim arrTable()
ReDim Preserve arrTable(UBound(arrLine), i)
For j = 0 To UBound(arrLine)
arrTable(j, i) = arrLine(j)
Next
'次のレコードに移動する
i = i + 1
Loop
'テーブルファイルを閉じる
Close #1
'テーブル配列の行列を入れ替える
'Transposeの出力は、配列が1から始まるように作成されます。
'レコードが1つしかない場合は1次元配列になってエラーが発生します。
arrTable = WorksheetFunction.Transpose(arrTable)
'テーブル配列をテーブルに書き込む
Range(strTable).Resize(UBound(arrTable, 1)) = arrTable
'ステータスバーを表示する
Application.StatusBar = "レコードファイルを読み込んでいます。"
'データベースフォルダからファイル名を読み込む
Dim strFile
strFile = Dir(strFolder & "\" & "*.TSV")
'レコードファイルが存在する間
Do While strFile <> ""
'テーブルファイルまたはコピーファイルの場合はスキップする
If strFile = "Table.TSV" Or InStr(strFile, "(") > 0 Then GoTo Skip
'レコードファイルを入力モードで開く
Open strFolder & "\" & strFile For Input As #1
'フィールド文字列を読み込む
'http://officetanaka.net/excel/vba/error/execution_error/error_62.htm
Dim strField
Do Until EOF(1)
Line Input #1, strField
Loop
'レコードファイルを閉じる
Close #1
'テーブルのすべての行を繰り返す
For r = 1 To Range(strTable).Rows.Count
'行のキーデータがファイル名と一致する場合
'http://officetanaka.net/excel/vba/function/Join.htm
'https://www.relief.jp/docs/excel-vba-woksheetfunction-textjoin.html
If WorksheetFunction.TextJoin("_", False, Range(Range(strTable)(r, 1), Range(strTable)(r, lngKeys))) _
& ".TSV" = strFile Then
'フィールド文字列がない場合
If Replace(strField, vbTab, "") = "" Then
'テーブルの行を削除する
Range(strTable).Rows(r).Delete
'フィールド文字列がある場合
Else
'フィールド文字列をキー列以降に書き込む
Range(Range(strTable)(r, lngKeys + 1), Range(strTable)(r, Range(strTable).Columns.Count - 1)) _
= Split(strField, vbTab)
'タイムスタンプを最終列に書き込む
Range(strTable)(r, Range(strTable).Columns.Count) = FileDateTime(strFolder & "\" & strFile)
End If
'処理をスキップする
GoTo Skip
End If
Next
'フィールド文字列がない場合は処理をスキップする
If Replace(strField, vbTab, "") = "" Then GoTo Skip
'最終行の次の行を把握する
r = Range(strTable).Rows.Count + 1
'ファイル名をキー列に書き込む
Range(Range(strTable)(r, 1), Range(strTable)(r, lngKeys)) = _
Split(Left(strFile, InStr(strFile, ".") - 1), "_")
'フィールド文字列をキー列以降の列に書き込む
Range(Range(strTable)(r, lngKeys + 1), Range(strTable)(r, Range(strTable).Columns.Count - 1)) = _
Split(strField, vbTab)
'タイムスタンプを最終列に書き込む
Range(strTable)(r, Range(strTable).Columns.Count) = FileDateTime(strFolder & "\" & strFile)
Skip:
'次のファイルを読み込む
strFile = Dir()
Loop
'セルの数値を入力し直す
'これを行わないと数値が文字列のままになります。
Range(strTable).Value = Range(strTable).Value
'ステータスバーを解除する
Application.StatusBar = False
Exit Sub
HdlErr:
'エラーメッセージを表示する
MsgBox "データベースからテーブルへの読み込みができませんでした。", vbExclamation
'ステータスバーを解除する
Application.StatusBar = False
'すべてのファイルを閉じる
Close
End Sub
処理速度向上のため、ClearFormatsメソッドを使ってテーブルの書式をすべて解除しています。
マクロの組み込み
データ共有マクロの起動は、次のようなイベントプロシージャでおこないます。
ThisWorkbookモジュール
'ワークブックを開いた場合に処理を行う
Private Sub Workbook_Open()
'データベースのデータを読み込む
Call TSV.ReadTable(Range("データベースフォルダ").Value, "テーブル", 1)
End Sub
シートモジュール
'ワークシートに変更が加えられた場合に処理を行う
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Long, s As Long
'ターゲット行列番号をテーブル行列番号に変換する
r = Target.Row - Range("テーブル").Row + 1
s = Target.Column - Range("テーブル").Column + 1
'テーブル行・列番号が入力範囲外の場合は終了する
If r < 1 Or Range("テーブル").Rows.Count < r Then Exit Sub
If s <= 1 Or Range("テーブル").Columns.Count <= s Then Exit Sub
'データをレコードファイルに書き込む
Call TSV.WriteRecord(Sheet91.Range("データベースフォルダ").Value, "テーブル", r, 1)
End If
End Sub
マクロを組み込んだエクセルファイル自体は、「読み取り専用」で使用することをおすすめします。外部データベース以外にデータを保存しないようにできるからです。エクセルファイルの保存時に「書き込みパスワード」を設定することで実現できます。
当サイトで紹介している「VA電話メモ」には、データ共有マクロをクラスが組み込まれています。
細部については、こちらの記事のサンプルファイルを参照してください。
関連記事
このマクロの作成にあたっては、次のサイトの記事を参考にさせていただきました。
素晴らしいアイデアを公表していただけた井上 治様に感謝申し上げます。
コメント
サンプル・ファイルに次の修正を加えました。
・モジュールレベル変数による値の共有を引数に変更
・一時データの保存時、同一ファイル名がある場合は削除するように変更
次の修正を加えました。
・ブックを閉じる際に一時データの削除を自動的に実行
・上記に伴い一時データの移動機能を削除
Microsoft365を利用している場合の情報共有方法について、記事の冒頭に注意書きを追加しました。
TSVファイルを一時データではなく、データベースとして利用するように変更し、同一のエクセルファイルを全員で利用するようにしました。(Ver200)
データベースにレコードファイルの内容をまとめたテーブルファイルを作るようにして、処理速度の向上を図りました。
テーブルがシートの最左上にない場合に対応していない部分がありましたので、修正しました。
コードを全面的に書き換えました。
不具合発生時の原因究明を容易にするため、配列の使用を最小限にしました。
データベースのキーが2つ以上の場合に最初のキーが重複するデータが表示されないバグを修正しました。
処理速度向上のため、ClearFormatsメソッドを使ってテーブルの書式をすべて解除するように変更しました。
テーブルファイルの読み込みに配列を利用して速度を向上させました。
データの入出力に関する記事を追加しました。