Excel：行列入替の２つのDBを常に双方向で同期

質問

Sheet1にフィールドが60、レコードが400程ある特許情報をまとめたDBを作成しており、
Sheet2にSheet1のDBを行列入れ替えてコピペしたものがあります。

入力の際、Sheet1を使いたい場合とSheet2を使いたい場合が混在し、且つ、DBの全体に入力箇所が点在します。
入力箇所は毎回変わるので、都度検索で探しながら入力を行っています。

この二つのSheetを双方向で同期させたいのですが、方法はございますでしょうか。

同期させたい情報は、値だけでなく、セルの色やフォント、フォントの色、サイズ等全てです。

例えば、
Sheet1のE3セルに「5050」と入力すれば
Sheet2のC5セルにも自動で「5050」と入力される。

Sheet2のC5セルを赤色にすれば、
Sheet1のE3セルも自動で赤色になる。

Sheet1のD列とE列を入れ替えたら
Sheet2の4行目と5行目が自動で入れ替わる。

といった感じです。

リンクや関数では出来ないと思うので、VBAになるかと思いますが、
知識がありません。

Windows7でエクセル2010を使用しております。

何卒宜しくお願い致します。

回答No.6

eden3616 · ベストアンサー

以下の方法のうち、

・エリアを決め込む方法
・変更があるたびに対象範囲を行列入替でコピーし直す方法

前者は処理速度は格段にあがりますが、行削除・入替に対応できないため後者で作成し直しました。

以下のVBAコードと入れ替えて使用してください。

■VBAコード

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'On Error GoTo era
'型宣言
Dim myRng As Range
Dim mySt(1) As Worksheet
Dim myDb(1) As Range
Dim myArea(1) As Range
Dim myRow As Long
Dim myCol As Long
Dim flag As Integer
Dim myBas As Range
Dim myBef As Range

'DB範囲設定（基準位置設定）
'1つ目のデータベースを設定
Set mySt(0) = Sheets("Sheet1")
Set myDb(0) = mySt(0).Range("A1")
'2つ目のデータベースを設定
Set mySt(1) = Sheets("Sheet2")
Set myDb(1) = mySt(1).Range("A2")

'対象シート判定
Select Case ActiveSheet.Name
Case mySt(0).Name
　　flag = 0
Case mySt(1).Name
　　flag = 1
Case Else
　　flag = -1
End Select
If flag = -1 Then Exit Sub
'基準セルを記憶
Set myBas = myDb(flag)
'最大変更範囲取得
Set myArea(0) = mySt(flag).Range(myDb(flag), myDb(flag).SpecialCells(xlCellTypeLastCell))
'反転コピー
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
flag = Int((2 - flag) / 2)
mySt(flag).Activate
Set myBef = Selection
Set myArea(1) = mySt(flag).Range(myDb(flag), myDb(flag).SpecialCells(xlCellTypeLastCell))
myArea(0).Copy
myArea(1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
myBef.Select
mySt(Int((2 - flag) / 2)).Activate
GoTo owari:
era:
MsgBox "エラー番号:" & Err.Number & vbCrLf & "エラー内容：" & Err.Description
owari:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

お礼

ありがとうございます！！！
動作確認致しました！
・行や列の削除、入替え
・行や列、或いはDB全体のその場でのコピペ
・関数の入ったセルの動作も問題なく
全てがスムーズに行える様になりました。

この度は長期間に渡り、何度も最後までお助け頂きありがとうございました。

社内ではエクセルDBが推奨されており、
ご教示頂いた内容は全社的に横展開して活用して行こうと思います。

本当にありがとうございました。

回答No.5

eden3616

>Sheet1の2行目全体を黄色にして、同じ場所にコピペしたところ、
　>Sheet2のB列が黄色になり、上手く行ったのですが、
　>Sheet2のE列を黄色にして同様にしたところ、
　>「実行時エラー'1004':　アプリケーション定義またはオブジェクト定義のエラーです。」
　>というのが現れて、「デバック」をクリックすると、
　>VBEの下から9行目から6行目までが黄色くハイライトされ、
　>黄色い矢印が下から6行目にありました。

行・列選択での変更ですと、その選択された行・列全体が変更されたとして処理されます。
「変更された行数」≦「エクセルの取扱可能な列数」であれば問題ないのですが、
これを超える場合にご提示のエラーが発生します。
（行変更で問題なかったのに、列変更でエラーになるのはこのせいです）

また別の問題として行・列全選択による変更ですと全ての選択セルをコピーするので
処理時間もかかるとおもいます。

全選択した場合の挙動ですがエクセルは以下の制限があります。
・エクセル2003以下では：65,536行、256列
　→　256行、256列以上のデータが取り扱えない
・エクセル2007以上では：1,048,576行、16,384列
　→　16,384行、16,384列以上のデータが取り扱えない
これにより対象のデータにおいて行数がエクセルの最大列数を超える場合において
同様のエラーが発生してしまいます。

変更範囲を超えた場合にコピー処理を行わないように修正しました。
下記のVBAコードと入れ替えて使用してみてください。

ただし・・・
このコードにおいても全選択を行った場合、選択範囲全てにおいて
上記変更内容を照査しますので処理時間がかかるとおもいます。

処理時間の短縮が必要であれば、以下の方法になると思います。
・最大行数最大列数を決め込む方法
・変更があるたびに、全セル削除→セル全体を相方へ毎回行列反転コピーする方法

■VBAコード

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo era
'型宣言
Dim myRng As Range
Dim mySt(1) As Worksheet
Dim myDb(1) As Range
Dim myRow As Long
Dim myCol As Long
Dim flag As Integer
Dim myBas As Range
Dim myBasAdr As Range

'DB範囲設定（基準位置設定）
'1つ目のデータベースを設定
Set mySt(0) = Sheets("Sheet1")
Set myDb(0) = mySt(0).Range("A1")
'2つ目のデータベースを設定
Set mySt(1) = Sheets("Sheet2")
Set myDb(1) = mySt(1).Range("A2")

'対象シート判定
Select Case ActiveSheet.Name
Case mySt(0).Name
　　flag = 0
Case mySt(1).Name
　　flag = 1
Case Else
　　flag = -1
End Select
If flag = -1 Then Exit Sub
'基準セルを記憶
Set myBas = myDb(flag)
'最大変更範囲取得
Set myBasAdr = mySt(flag).Range(myBas, myBas.SpecialCells(xlCellTypeLastCell))
'反転コピー
flag = Int((2 - flag) / 2)
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each myRng In Target
　　If Not Application.Intersect(myRng, myBasAdr) Is Nothing Then
　　　　If myRng.Row < Columns.Count Then
　　　　　　myRng.Copy
　　　　　　myDb(flag).Offset( _
　　　　　　　　myRng.Column - myBas.Column, _
　　　　　　　　myRng.Row - myBas.Row _
　　　　　　).PasteSpecial Paste:=xlPasteAll
　　　　End If
　　End If
Next
GoTo owari:
era:
MsgBox "エラー番号:" & Err.Number & vbCrLf & "エラー内容：" & Err.Description
owari:
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

お礼

処理時間については改善方法は無いと勝手に思って諦めておりましたので、問題点として挙げて頂けて大変有難かったです。

方法もご提案頂き、本当にありがとうございます。

補足

ありがとうございます！！！

ご教示頂きましたVBAでテストを行いました。
行全体、列全体の色を変更し、その場にコピペを行ったところ、お陰様でうまく行きましたし、昨日よりは速くなりました。

続いて、行の入れ替えを試したところ、仰る通り、貼り付けた行だけ反映されて、切り取った行や、挿入入替えによる移動した行は反映されませんでしたので、変更された行（10行程）を同じ場所にコピペしたところ、1行だけの時と違い、かなりの処理時間を要しました。
場合によってはもっと沢山の行を指定することになるので、処理時間の短縮が可能なのであれば是非ともやりたいです。

eden3616さんにご協力頂きましたお陰で、ここまで出来上がって来ましたので、使いやすいものに仕上げて、今後ずっと活用していきたいと思います。

・最大行数最大列数を決め込む方法
・変更があるたびに、全セル削除→セル全体を相方へ毎回行列反転コピーする方法

について引き続きご教示頂けますでしょうか。
何卒宜しくお願い致します。

回答No.4

eden3616

変更箇所のみの同期をしているため、行全体・列全体の入替ですと異動先の行・列のみしか反映されませんね。
そのような処理を行っているのであれば
No1・2に提示したコードではデータが欠損する可能性があります。

変更があるたびに、全データを反転コピーするようにすれば良いとは思いますが。

お礼

更なる補足をありがとうございます。

>変更箇所のみの同期をしているため、
>行全体・列全体の入替ですと
>異動先の行・列のみしか反映されませんね。

このことに気付いておりませんでしたので大変助かりました。

お陰様で列の入れ替えでエラーが出ることにも気付くことが出来ました。
ありがとうございます。

補足

更なる補足をありがとうございます。
行全体 或いは 列全体 をコピーして、同じ場所にペーストすることで対応できないか、色々試してみようとしたところ、
Sheet1の2行目全体を黄色にして、同じ場所にコピペしたところ、Sheet2のB列が黄色になり、上手く行ったのですが、
Sheet2のE列を黄色にして同様にしたところ、「実行時エラー'1004':　アプリケーション定義またはオブジェクト定義のエラーです。」というのが現れて、「デバック」をクリックすると、VBEの下から9行目から6行目までが黄色くハイライトされ、黄色い矢印が下から6行目にありました。

myDb(flag).Offset( _
myRng.Column - myBas.Column, _
myRng.Row - myBas.Row _
).PasteSpecial Paste:=xlPasteAll

何度やっても同じ現象が起こります。

行全体・列全体の入替以外でも、
広範囲の変更の場合は手動で行列入替えのコピペで対応した方が良いのでしょうか。

宜しくお願い致します。

回答No.3

K Kazz（@JazzCorp）

２つ？
マスタは１つにすべき、、、
その程度のデータ量なら一瞬で変換も、そして逆変換もできる、、、

お礼

ご教示ありがとうございます。

そうなのです。２つ使いたいと思っています。
通常は１つで、そうすべきだという考えが一般的だというのは、今回ご意見を頂いたのを切っ掛けに友人に訪ねてみたりして、お陰様で勉強になりました。

ただ、今回取り扱う特許DBの場合、どちらの方法が良いのかは不勉強な為、まだ理解できておりませんので、今後も勉強を続けて理解し、あるべき姿に近づけて行けたらと思います。

この度はご回答をありがとうございました。

回答No.2

eden3616

No1に補足です。

このコードが動作するタイミングは
設定したデータベースのどちらかのシートが選択されている状態で
セルの値が変更された場合です。

ここでいう変更は、前と後の値が変わったではなく、
F2を押してEnterのようにセルの内容が書き換わる可能性のある動作
になります。

セルの罫線変更や背景色、文字色の変更のみを行った場合は反映されません。

上記書式のみの変更を行った場合は、対象のセルを選択し、F2→エンターを押してください。
大量にある場合はその範囲をコピーの後、同じ場所に張り付けてください。

書式ごと反転セルにコピーされます。

お礼

こちらの補足説明も大変助かりました。
特許の状況をレコード毎に色分けしていますので、
背景色の変更作業も多発しますし、レコード全体を変更しますので、範囲が広いです。
コピーペーストやF2+Enterで対応できるとのこと、大変助かります。
ありがとうございます。

回答No.1

eden3616

VBAで変更されたセルは戻すことが出来ません。
必ずデータのバックアップをとったうえで、動作テスト願います。

(1)最下のVBAコードを「ThisWorkbook」モジュールに記述してください。

　以下のサイトを参考にしてください。
　http://officetanaka.net/excel/vba/beginner/10.htm

(2)コード内の「'DB範囲設定（基準位置設定）」の部分を変更してください。

　１つ目と2つ目のデータベースについて「シート名」と「基準セル」を設定してください。
　基準セルとはデータベース範囲において実データエリア（タイトルエリアを除く範囲）の左上のセルアドレスになります。
　（添付画像において黄色着色のセル）

　　現在の設定は以下のようになります。
　　　　1つ目のデータベース　「Sheet1」の「A1」で設定
　　　　2つ目のデータベース　「Sheet2」の「A2」で設定

(3)セルの値に変更があれば変更セルと基準セルの差分を行・列反転したセルを対象としてコピーします。

■VBAコード

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
'型宣言
Dim myRng As Range
Dim mySt(1) As Worksheet
Dim myDb(1) As Range
Dim myRow As Long
Dim myCol As Long
Dim flag As Integer
Dim myBas As Range

'DB範囲設定（基準位置設定）
'1つ目のデータベースを設定
Set mySt(0) = Sheets("Sheet1")
Set myDb(0) = mySt(0).Range("A1")
'2つ目のデータベースを設定
Set mySt(1) = Sheets("Sheet2")
Set myDb(1) = mySt(1).Range("A2")

'対象シート判定
Select Case ActiveSheet.Name
Case mySt(0).Name
　　flag = 0
Case mySt(1).Name
　　flag = 1
Case Else
　　flag = -1
End Select
If flag = -1 Then Exit Sub
'基準セルを記憶
Set myBas = myDb(flag)
'反転コピー
flag = Int((2 - flag) / 2)
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each myRng In Target
　　myRng.Copy
　　myDb(flag).Offset( _
　　　　myRng.Column - myBas.Column, _
　　　　myRng.Row - myBas.Row _
　　).PasteSpecial Paste:=xlPasteAll
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

お礼

eden3616 様

補足質問の件は解決致しました。

http://atamoco.boy.jp/vba/excel/book/securitycenter.php

こちらを参照し、マクロの設定の部分で、
「デジタル署名されたマクロを除き、すべてのマクロを無効にする」にチェックが入っていたのを、
「警告を表示してすべてのマクロを無効にする」にチェックを入れたところ、機能が復活しました。

ありがとうございます。

お陰様で、今回の改善が達成できたことを、部員全員で喜んでおります。
業務改善のプレゼンでも発表したいと思います。

本当に本当にありがとうございました。

補足

eden3616 様

迅速に、ご丁寧にご対応頂き、大変感謝しております。
ありがとうございます。

仰る通りにやってみたところ、思い通りに一旦なったのですが、保存して閉じて、再度開いて試してみたところ、全く反映されなくなってしまいました。

反映されないというのは、
Sheet1に入力した内容がSheet2に自動入力されず、
その逆も同じでした。

保存の際は、マクロ有効ブックで保存致しました。

何卒宜しくお願い致します。