見出し画像
Photo by sinoayakouri

VBAでファイル共有

nJun Excel VBA 職人

複数のパソコンで情報を共有する

久しぶりの投稿です。
ここ暫く投稿に割く時間が取れず、空白の時間が続きました。

最近バーコードを利用して、イベントの参加者受付をする機会が増えてきて、参加者数が多いときには複数のパソコンで処理することもあります。
そこで今回は、複数のパソコンで処理したデータを集約する仕組みについて説明します。
 
前提として、２台のパソコン(例PC1,PC2)がLANで接続されていてPC1の共有フォルダをPC1とPC2で共有できる環境になっているものとします。
 
この環境のPC1共有フォルダにExcelのBookや画像ファイルなどを置くとPC1,PC2のどちらからでも開くことが可能です。
ただし、Bookについてはいずれか1台が開いていると、2台目以降では「読み取り専用」で開かれます。つまり、1台目ではデータ更新ができても2台目以降では更新できません（これを排他制御といいます）。
これでは、２台以上で同時に更新処理することは難しいようです。
 
そこで、同一のBookをPC1用とPC2用に二つ用意して、時々PC1からPC2を覗いて集約するとうまくいきます。
 
詳細は次のとおりです。
まず、環境のイメージを図示すると

環境イメージ

となります。
PC1とPC2がLANで繋がっていて、PC1の共有FolderにSubFolder「受付」を作りその中に、PC１で処理する「受付_PC1」とPC2で処理する「受付_PC2」を格納します。
そして、このBookにショートカットを作り、それぞれのPCに置くと、開くときの手数が少なくなります。

つぎに、実際の処理イメージを図示すると

受付処理中のBook

PC1とPC2でそれぞれの「受付_PCｎ」（ｎは1or2)を開いて、受付処理をした状況が「受付時刻」の欄に記録されています。
このまま処理を続けて数名分の処理が終了した時点で、随時「上書き保存」ボタンをクリックしておきます。
その後、PC1の「IMPORT」ボタンをクリックすると「受付_PC2xlsm」の状況がImportされます。

Import後の表示

「受付時刻」の欄にPC2のDATAがセットされます。
このとき、DATAが識別できるようにImportした方にはPC_ID（PC2）が付けてあります。ここで注意すべき点は、PC2が「上書き保存」した直後のDATAがImportされることです。
また、DATAの整合性を保つために、この機能は「PC１」のみで実施可能とすることにします。そこで、PC2で「IMPORT」をクリックするとError表示を出しています。

Error表示[No operaton rights]

なお、実際のバーコード読み込み処理の詳細についてはVBAでBarCode_読込1～3をご参照ください。

それでは、ザックリとAlgorithmを考えてみましょう。
1．PC1以外のときは処理しない。
2．TargetとなるBook（受付_PC2xlsm）は他のPCであるPC2で開いている　　　　　
　が、このPC1でも改めて開く。
3．受付_PC2xlsmのSheet「名簿」のDATAを１行ずつ最後まで読取りながら
　次の処理をする。
　・F列（受付時刻）がBlank以外のとき
　　B列の出席者IDと受付_PC1xlsm（Thisworkbook）のSheet「名簿」B列の
　　出席者IDを比較して、一致するものを探す。
　　一致したら、ThisworkbookのSheet「名簿」F列とG列にそれぞれの値を
　　書き込む。
4.処理終了後、受付_PC2xlsmを閉じる。

随分ザックリですが、これを基にコーディングしてみます。
Procedure名をIMPORTとしてSub IMPORT()から始めます
1． If ThisWorkbook.Name <> "受付_PC1.xlsm" Then MsgBox "No 　　operaton rights": Exit Sub
　　ThisWorkbook.NameはこのProcedureを含むBook名のことで、受付
　　_PC1.xlsmでクリックするとThisWorkbook.Nameは受付_PC1.xlsmとな
　　り、受付_PC2.xlsmでクリックすると当然「受付_PC2.xlsm」となりま
　　す。
　　したがって、ThisWorkbook.Nameが「受付_PC1.xlsm」以外のときは
　　「No operaton rights」のメッセージを表示して、Procedureを抜けるよ
　　うにします。
2-1．LR = Cells(Rows.Count,"B").End(xlUp).Row
　　受付_PC1の列Bに入力されている最終行を変数LRにPUTする
　　DR = ThisWorkbook.Pathで自身の居場所をDRにPUTする
　　先程のThisWorkbook.Nameは自身の名前でしたが、PathはどのFolderに
　　あるか？（居場所はどこか？）になります。
2-2．Workbooks.Open DR & "¥受付_PC2.xlsm"で受付_PC2.xlsmを開きま
　　す。
　　Bookを開く構文は「どこどこにあるどのファイルを開け」となります。
　　ここでは、自身と同じPath（Folder）にある受付_PC2.xlsmを開くことを
　　意味します。
　　受付_PC2.xlsmの前にある「¥」は、Pathの区切り文字として必要なもの
　　なので注意してください。
　　これは、プロパティで確認できるので、後述の「プロパティ」をご覧く
　　ださい。
2-3．Sheets("名簿").Select
　　Sheet「名簿」の情報を必要とするので当シートを活動状態にする。
3-1．LS = Cells(Rows.Count, "B").End(xlUp).Row
　　受付_PC2の列Bに入力されている最終行を変数LSにPUTする
3-2．For n = 3 To LS
　　　 If Cells(n, "F") <> "" Then
　　　［一連の処理］⇒実際は3-3をここに記述する
　　　End If
　 　Next n
　　受付_PC2を3行目からLS(最終行)まで見ながら
　　n行F列がBlankでないとき[一連の処理]をする
3-3．For s = 3 To LR
　　 　If Cells(n, "B") = ThisWorkbook.Sheets("名簿").Cells(s, "B") Then
　　　　ThisWorkbook.Sheets("名簿").Cells(s, "F") = Cells(s, "F")
　　　　ThisWorkbook.Sheets("名簿").Cells(s, "G") = "PC2"
　　　　Exit For
　　　End If
　　Next s
　　受付_PC1を3行目からLR(最終行)まで見ながら
　　n行B列と受付_PC1のs行B列が一致したとき
　　　受付_PC2の受付時刻をPC1にPUT
　　　PC_ID（PC2）をPC1にPUT
　　 　Loopから抜ける(Next sの次の行へ飛ぶ）
4．Workbooks("受付_PC2.xlsm").Close
　　処理が完了したら受付_PC2.xlsmを閉じる

最後にEnd sub です。

「プロパティ」を確認するには、Book名を右クリックして表示されるウィザードの最下部「プロパティ」をクリックすると、下図が表示できます。

「受付_PC2.xlsm」のプロパティ

階層順に繋がったFolderを辿るとTargetFileに到達します。

参考までにコーディングの完成形を置いておきます。

Sub IMPORT()

    If ThisWorkbook.Name <> "受付_PC1.xlsm" Then MsgBox "No operaton rights": Exit Sub

    LR = Cells(Rows.Count, "B").End(xlUp).Row '受付_PC1の最終DATA行

    DR = ThisWorkbook.Path
    Workbooks.Open DR & "\受付_PC2.xlsm"
    Sheets("名簿").Select

    LS = Cells(Rows.Count, "B").End(xlUp).Row '受付_PC2の最終DATA行
    For n = 3 To LS '受付_PC2をSearchするためのLoop
      If Cells(n, "F") <> "" Then '受付_PC2のn行F列がBlankでないとき
      
         For s = 3 To LR '受付_PC1をSearchするためのLoop
           If Cells(n, "B") = ThisWorkbook.Sheets("名簿").Cells(s, "B") Then '受付_PC2のn行B列と受付_PC1のs行B列が一致したとき
              ThisWorkbook.Sheets("名簿").Cells(s, "F") = Cells(s, "F")      '受付_PC2の受付時刻
              ThisWorkbook.Sheets("名簿").Cells(s, "G") = "PC2"              'PC_ID
              Exit For '受付_PC1をSearchするためのLoopから抜ける
           End If
         Next s

      End If
    Next n

    Workbooks("受付_PC2.xlsm").Close '受付_PC2を閉じる

End Sub


補足
LAN環境がない場合は、1台のPCでもテスト可能です。
冒頭のSubFolder「受付」をそのままデスクトップ等に作り、「受付_PC1xlsm」と「受付_PC2xlsm」を両方開いて、「受付時刻」の欄に適当な時刻を入力したあと「受付_PC2xlsm」の上書き保存ボタンでデータ更新してください。
この状態で「受付_PC1xlsm」のIMPORTボタンをクリックすると、「受付_PC2xlsm」の時刻が取り込まれるはずです。
だだし、この環境では処理終了後「受付_PC2xlsm」がCloseされますが、LAN環境ではCloseされることはないので、安心してください。

また、逆に3台4台と増設したいときは、IMPORTのTargetを選べるようにするなどすれば分かりやすいと思うので、挑戦してみてください。

随分久しぶりの投稿となりましたが、今回も最後までご覧いただき、ありがとうございました。

この記事が気に入ったらサポートをしてみませんか？