SharePointの「共同編集」は大変魅力的な機能です。特にオンライン版のエクセルでは、完璧に機能していると思います。
ただし、デスクトップ版のエクセルでは正常に機能しないことも多いようです。特に、VBAを使ったファイルを共同編集することができない場合が少なくありません（当方の環境によるものかもしれません。）
さらに、法律事務所の場合、セキュリティ上の観点からSharePoint上にファイルをそのまま置くことができない場合も多いと思います。
そこでVBAアセットでは、CSVファイルを利用した簡易的なデータベースをエクセルの外部に作って、データをそこに保存するようにしています。こうすれば、VBAを使う場合でも、データファイルを安全な領域に保存したうえで共同編集を行うことが可能になります。
なお、SharePoint上に置いてもセキュリティ上問題のないデータであれば、エクセルよりもMicrosoftListなどを使ったほうが便利です。
CSVファイルを使ったデータ共有の原理
ユーザーがエクセルファイルにデータを入力した際には、そのテーブルのレコード（行）データをレコードファイル（TSVファイル）に書き込みます。（CSVファイルはカンマを区切り文字に使うのが一般的ですが、データに「,」が使われることが考えられるため区切り文字にタブを使ったTSVファイルを使用しています。）
排他性をもたせるため、レコードファイルのファイル名をテーブルのキー列にしています。（図のように「キー」にユーザー名を加えることができば、排他性がより高まります。）
また、テーブルの更新日時とタイムスタンプを比較することで、他の人が変更したデータを上書きする場合はメッセージが表示されるようにしています。（他の人が変更したデータを選択した場合は、レコードファイルの内容をテーブルのレコードに上書きします。）
速度を向上させるため、テーブル全体のデータはテーブルファイルに保存しています。エクセルを起動した際には、テーブルファイルとすべてのレコードファイルからデータの読込を行います。（その日のレコードファイルの数が増えると読込に時間がかかるようになります。その場合は、データの読込が終わってからテーブル全体をテーブルファイルに書込み、すべてのレコードファイルを削除するようにします。
注意：プログラムの制約上、レコードが1つ以下の場合は読込ができません。（対応も可能ですが、実用上は問題ないので放置してあります。）
データ共有マクロ
CSVファイルを利用した外部データベースを使うためには、「WriteToTSV」、「ReadFromTSV」、「WriteToTSVs」および「ReadFromTSVs」の4つのプロシージャが必要となります。
WriteToTSV
テーブルレコードをレコードファイルに書きこみます。
引数：データベースフォルダ,テーブル名,レコード番号,キー列の数
Sub WriteToTSV(strFolder As String, strTable As String, r As Long, lngKeys As Long)
'テーブルレコードをレコードファイルに書きこみます。
'エラー処理を設定する
On Error GoTo HdlErr
'ステータスバーを表示する
Application.StatusBar = "データを読み込んでいます。（レコード→レコード配列）"
'レコード配列を宣言する
Dim varRecord As Variant
'テーブル行の値をレコード配列に入力する
'インデックスは(1,1)から始まります。
Dim rngTable As Range
Set rngTable = Range(strTable)
varRecord = rngTable.Rows(r).Value
'ファイル名配列を定義する
'キーデータの数だけにします。
Dim varFile() As Variant
ReDim varFile(1 To lngKeys)
'ファイル名配列にキーデータを代入する
Dim i As Long
For i = 1 To lngKeys
varFile(i) = varRecord(1, i)
Next
'ファイル名配列を結合してファイル名を取得する
Dim strFile As String
strFile = Join(varFile, "_")
'ファイルパスを把握する
Dim strPath As String
strPath = strFolder & "\" & strFile & ".TSV"
'フィールド配列を定義する
'キーデータの次の列から「更新日時」の手前までにします。
Dim varField As Variant
ReDim varField(lngKeys + 1 To UBound(varRecord, 2) - 1)
'フィールド配列にフィールド文字列を代入する
'インデックスはキーデータの次の値からになります。
For i = lngKeys + 1 To UBound(varRecord, 2) - 1
varField(i) = varRecord(1, i)
Next
'フィールド配列を結合してフィールドテキストを取得する
Dim strField As String
strField = Join(varField, vbTab)
'レコードファイルが存在する場合
If Dir(strPath) <> "" Then
'タイムスタンプがレコードの更新日時よりも新しい場合
If varRecord(1, UBound(varRecord, 2)) < FileDateTime(strPath) Then
'上書きが拒否された場合
If MsgBox(strFile & "は他の人によって変更されています。" & vbCr & _
"自分が入力したデータで上書きしますか？", vbYesNo) = vbNo Then
'レコードファイルのデータを読み込む
Call TSV.ReadFromTSV(strFolder, strTable, r, lngKeys)
'終了する
Exit Sub
End If
End If
End If
'ステータスバーを表示する
Application.StatusBar = "データを読み込んでいます。（レコード配列→レコードファイル）"
'レコードファイルを出力モードで開く
'ファイルが存在しない場合は新規に作成されます。
Open strPath For Output As #1
'フィールド文字列をレコードファイルに書き込む
Print #1, strField
'レコードファイルを閉じる
Close #1
'テーブル行のタイムスタンプを修正する
rngTable.Cells(r, rngTable.Columns.Count).Value = FileDateTime(strPath)
'ステータスバーを解除する
Application.StatusBar = False
'エラー処理を解除する
On Error GoTo 0
Exit Sub
HdlErr:
'エラーメッセージを表示する
MsgBox strTable & "の" & r & "番目のレコードをレコードファイルに書き込めませんでした。", vbExclamation
'ステータスバーを解除する
Application.StatusBar = False
'レコードファイルを閉じる
Close
End SubReadFromTSV
テーブルレコードをレコードファイルから読み込みます。
引数：データベースフォルダ名, テーブル名, レコード番号,キー列の数
Sub ReadFromTSV(strFolder As String, strTable As String, r As Long, lngKeys As Long)
'テーブルレコードをレコードファイルから読み込みます。
'エラー処理を設定する
On Error GoTo HdlErr
'ステータスバーを表示する
Application.StatusBar = "データを読み込んでいます。（レコード→レコード配列）"
'レコード配列を宣言する
Dim varRecord As Variant
'レコードをレコード配列に入力する
'インデックスは(1,1)から始まります。
Dim rngTable As Range
Set rngTable = Range(strTable)
varRecord = rngTable.Rows(r).Value
'ファイル名配列を定義する
'キーデータの数だけにします。
Dim varFile() As Variant
ReDim varFile(1 To lngKeys)
'ファイル名配列にキーデータを代入する
Dim i As Long
For i = 1 To lngKeys
varFile(i) = varRecord(1, i)
Next
'ファイル名配列を結合してファイル名を取得する
Dim strFile As String
strFile = Join(varFile, "_")
'ファイルパスを把握する
Dim strPath As String
strPath = strFolder & "\" & strFile & ".TSV"
'フィールド配列を定義する
'キーデータの次の列から「更新日時」の手前までにします。
Dim varField As Variant
ReDim varField(lngKeys + 1 To UBound(varRecord, 2) - 1)
'フィールド配列にフィールド文字列を代入する
'インデックスはキーデータの次の値からになります。
For i = lngKeys + 1 To UBound(varRecord, 2) - 1
varField(i) = varRecord(1, i)
Next
'フィールド配列を結合してフィールドテキストを取得する
Dim strField As String
strField = Join(varField, vbTab)
'フィールド文字列がある場合
If Replace(strField, vbTab, "") <> "" Then
'メッセージを表示する
If MsgBox("他の人のデータを読み込みますか？", vbYesNo) = vbNo Then
'処理を終了する
Exit Sub
End If
End If
'ステータスバーを表示する
Application.StatusBar = "データを読み込んでいます。（レコードファイル→レコード配列）"
'レコードファイルを入力モードで開く
Open strPath For Input As #1
'フィールド文字列を読み込む
Line Input #1, strField
'フィールド配列にフィールド文字列を代入する
'インデックスは0からになります。
varField = Split(strField, vbTab)
'レコードファイルを閉じる
Close #1
'フィールド配列をレコード配列に入れる
Dim j As Long
For j = 0 To UBound(varField)
varRecord(1, j + lngKeys + 1) = varField(j)
Next
'タイムスタンプをレコード配列に加える
varRecord(1, UBound(varRecord, 2)) = FileDateTime(strPath)
'ステータスバーを表示する
Application.StatusBar = "データを読み込んでいます。（レコード配列→レコード）"
'レコードにレコード配列データを代入する
rngTable.Rows(r) = varRecord
'セルの書式を適用する
'これを行わないと数値が文字列のままになります。
rngTable.Rows(r).Value = rngTable.Rows(r).Value
'ステータスバーを解除する
Application.StatusBar = False
'エラー処理を解除する
On Error GoTo 0
Exit Sub
HdlErr:
'エラーメッセージを表示する
MsgBox strTable & "の" & r & "番目のレコードをレコードファイルから読み込めませんでした。", vbExclamation
'ステータスバーを解除する
Application.StatusBar = False
'レコードファイルを閉じる
Close
End SubWriteToTSVs
テーブル全体をテーブルファイルに書き込んで、レコードファイルを削除します。
引数：データベースフォルダ名,テーブル名,キー列の数
Sub WriteToTSVs(strFolder As String, strTable As String, lngKeys As Long)
'テーブル全体をテーブルファイルに書き込んで、レコードファイルを削除します。
'エラー処理を設定する
On Error GoTo HdlErr
'ステータスバーを表示する
Application.StatusBar = "データを書き込んでいます。（テーブル→テーブル配列）"
'テーブル配列を宣言する
Dim varTable As Variant
'テーブルの値をテーブル配列に入力する
'インデックスは(1,1)から始まります。
Dim rngTable As Range
Set rngTable = Range(strTable)
varTable = rngTable.Value
'ステータスバーを表示する
Application.StatusBar = "データを書き込んでいます。（テーブル配列→テーブルファイル）"
'テーブルファイルを出力モードで開く
'ファイルが存在しない場合は新規に作成されます。
Open strFolder & "\" & "Table.TSV" For Output As #1
'テーブルファイルにテーブル配列の値を入力する
Dim i As Long, j As Long
For i = 1 To UBound(varTable, 1)
Dim varLine As Variant
ReDim varLine(1 To UBound(varTable, 2))
For j = 1 To UBound(varTable, 2)
varLine(j) = varTable(i, j)
Next
Dim strline As String
strline = Join(varLine, vbTab)
'TSVファイルに書き込む
''データの書き込みには、Printステートメントを使用しています。Writeステート
''メントも使えますが、各データがダブルクォーテーション（"）で囲まれ、日付
''データがハッシュ（#）で囲まれるなど、使い勝手が良くありません。
Print #1, strline
Next
'テーブルファイルを閉じる
Close #1
'ステータスバーを表示する
Application.StatusBar = "データを書き込んでいます。（レコードファイルを削除）"
'データベース内のファイルを検索する
Dim strFile As String
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
'エラー処理を解除する
On Error GoTo 0
Exit Sub
HdlErr:
'エラーメッセージを表示する
MsgBox strTable & "をテータベースに書き込めませんでした。", vbExclamation
'ステータスバーを解除する
Application.StatusBar = False
'TSVファイルを閉じる
Close
End SubReadFromTSVs
データベースから全てのデータを読み込んでテーブルを書き換えます。
引数：データベースフォルダ名,テーブル名,キー列の数
Sub ReadFromTSVs(strFolder As String, strTable As String, lngKeys As Long)
'データベースから全てのデータを読み込んでテーブルを書き換えます。
'エラー処理を設定する
On Error GoTo HdlErr
'ステータスバーを表示する
Application.StatusBar = "データを読み込んでいます。（テーブル配列←テーブルファイル）"
'テーブルファイルを入力モードで開く
Open strFolder & "\" & "Table.TSV" For Input As #1
'テーブルファイルの終端まで繰り返す
Dim i As Long, j As Long
i = 1
Do Until EOF(1)
'ライン文字列を読み込む
''読み込みには、Line Inputステートメントを使用しています。書き込みにPrintス
''テートメントを使用していることもあり、対になるコマンドであるLine Inputを使
''用しています。
''これについては、「Excel VBA本格入門」（大村あつし著）のp524に詳しい説明が
''あります。
Dim strline As String
Line Input #1, strline
'ライン文字列をライン配列に代入する
Dim varLine As Variant
varLine = Split(strline, vbTab)
ReDim Preserve varLine(1 To UBound(varLine) + 1)
'テーブル配列を定義する
Dim varTable() As Variant 'テーブル配列
ReDim Preserve varTable(1 To UBound(varLine), 1 To i)
'テーブル配列にライン配列データを代入する
For j = 1 To UBound(varLine)
varTable(j, i) = varLine(j)
Next
'次のレコードを処理する
i = i + 1
Loop
'テーブルファイルを閉じる
Close #1
'ステータスバーを表示する
Application.StatusBar = "データを読み込んでいます。（テーブル配列←レコードファイル）"
'データベースフォルダからファイル名を読み込む
Dim strFile As String
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
'フィールド文字列を読み込む
Dim strField As String
Line Input #1, strField
'フィールド文字列をフィールド配列に代入する
Dim varField As Variant
varField = Split(strField, vbTab)
ReDim Preserve varField(1 To UBound(varField) + 1)
'レコードファイルを閉じる
Close #1
'テーブル配列の最終レコードまで繰り返す
For i = 1 To UBound(varTable, 2)
'ファイル名配列を宣言する
Dim varFile As Variant
ReDim varFile(1 To lngKeys)
'テーブルファイルのキーデータをファイル名配列に入れる
For j = 1 To lngKeys
varFile(j) = varTable(j, i)
Next
'ファイル名配列を結合したものがファイル名と同一の場合
If Join(varFile, "_") & ".TSV" = strFile Then
'繰り返しを終了する
Exit For
End If
Next
'同一キーがなかった場合
If i = UBound(varTable, 2) + 1 Then
'フィールド文字列がない場合
If Replace(strField, vbTab, "") = "" Then
'フィールド文字列がある場合
Else
'テーブル配列を再宣言する
ReDim Preserve varTable(1 To UBound(varTable, 1), 1 To UBound(varTable, 2) + 1)
'ファイル名をテーブル配列に入れる
varFile = Split(Left(strFile, InStr(strFile, ".") - 1), "_")
ReDim Preserve varFile(1 To UBound(varFile) + 1)
For j = 1 To UBound(varFile)
varTable(j, i) = varFile(j)
Next
'フィールド配列をテーブル配列に入れる
For j = 1 To UBound(varField)
varTable(lngKeys + j, i) = varField(j)
Next
'タイムスタンプをテーブル配列に加える
varTable(UBound(varTable, 1), i) = FileDateTime(strFolder & "\" & strFile)
End If
'同一キーがあった場合
Else
'フィールド文字列がない場合
If Replace(strField, vbTab, "") = "" Then
'同一キーのレコードから最終レコードの手前まで繰り返す
For i = i To UBound(varTable, 2) - 1
For j = 1 To UBound(varTable, 1)
'次のレコードで上書きする
varTable(j, i) = varTable(j, i + 1)
Next
Next
'テーブル配列の最終レコードを削除する
ReDim Preserve varTable(1 To UBound(varTable, 1), 1 To UBound(varTable, 2) - 1)
'フィールド文字列がある場合
Else
'テーブル配列にフィールド配列を上書きする
For j = 1 To UBound(varField)
varTable(lngKeys + j, i) = varField(j)
Next
'タイムスタンプをテーブル配列に上書きする
varTable(UBound(varTable, 1), i) = FileDateTime(strFolder & "\" & strFile)
End If
End If
Skip:
'次のファイルを読み込む
strFile = Dir()
Loop
'ステータスバーを表示する
Application.StatusBar = "データを読み込んでいます。（テーブル←テーブル配列）"
Dim rngTable As Range
Set rngTable = Range(strTable)
'テーブルにデータがあれば削除する
If WorksheetFunction.CountA(rngTable) <> 0 Then rngTable.Delete
'テーブル配列の行列を入れ替える
'レコードが1つしかない場合は1次元配列になってエラーが発生します。
varTable = WorksheetFunction.Transpose(varTable)
'テーブルにテーブル配列データを代入する
'テーブルのサイズをテーブル配列の大きさに合わせてから代入しています。
'速度が遅くなるのでテーブル外に保存するように修正しました。
With Worksheets(rngTable.Parent.Name)
'テーブル外のシートにテーブル配列を代入する
'テーブル内に配列を代入すると遅いので一旦テーブル外に代入します。
Dim k As Long, l As Long 'テーブル直下の行及び列
k = rngTable.Row + rngTable.Rows.Count
l = rngTable.Column
Range(.Cells(k, l), .Cells(k - 1 + UBound(varTable, 1), l - 1 + UBound(varTable, 2))) = varTable
'シート上の値をテーブル内にカットアンドペーストする
Range(.Cells(k, l), .Cells(k - 1 + UBound(varTable, 1), l - 1 + UBound(varTable, 2))).Cut (rngTable(1, 1))
End With
'ステータスバーを解除する
Application.StatusBar = False
'エラー処理を解除する
On Error GoTo 0
Exit Sub
HdlErr:
'エラーメッセージを表示する
MsgBox strTable & "をテータベースから読み込めませんでした。", vbExclamation
'ステータスバーを解除する
Application.StatusBar = False
'TSVファイルを閉じる
Close
End Sub
マクロの組み込み
データ共有マクロの起動は、次のようなイベントプロシージャでおこないます。
ThisWorkbookモジュール
'ワークブックを開いた場合に処理を行う
Private Sub Workbook_Open()
'データベースのデータを読み込む
Call TSV.ReadFromTSVs(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.WriteToTSV(Sheet91.Range("データベースフォルダ").Value, "テーブル", r, 1)
End If
End Sub
当サイトで紹介している「VA電話メモ」には、データ共有マクロをクラスが組み込まれています。
細部については、こちらの記事のサンプルファイルを参照してください。
関連記事
このマクロの作成にあたっては、次のサイトの記事を参考にさせていただきました。
素晴らしいアイデアを公表していただけた井上 治様に感謝申し上げます。
配布の問題(１つのExcelブックを大勢が開く場合の対処)
www.asahi-net.or.jp
コメント
サンプル・ファイルに次の修正を加えました。
・モジュールレベル変数による値の共有を引数に変更
・一時データの保存時、同一ファイル名がある場合は削除するように変更
次の修正を加えました。
・ブックを閉じる際に一時データの削除を自動的に実行
・上記に伴い一時データの移動機能を削除
Microsoft365を利用している場合の情報共有方法について、記事の冒頭に注意書きを追加しました。
TSVファイルを一時データではなく、データベースとして利用するように変更し、同一のエクセルファイルを全員で利用するようにしました。（Ver200）
データベースにレコードファイルの内容をまとめたテーブルファイルを作るようにして、処理速度の向上を図りました。
テーブルがシートの最左上にない場合に対応していない部分がありましたので、修正しました。