Excel VBAについて

質問

VBA初心者です。
社内の様式に合うようなVBAを組みたいのですが。。。
１，様式は表になっており１つのグループに5つの選択肢があり横に5グループ，縦に12グループあります。（例えば１行目にA1.A2.A3.A4.A5|B1.B2.B3.・・・・E3.E4.E5
２行目にF1.F2.F3.F4.F5|G1.G2・・・・１２行目にBM1.BM2のような表）
２，シートは２枚あり１枚目のシートで選んだ1グループ1項目に１つだけ○がつく（ダブルクリックで選択し，違う項目を選択すれば前に選んだ項目の○は消える。）
３，１枚目に丸がついた項目が２枚目の任意のセルに表示される（例えば１枚目のシートのＡグループのA3を選択すれば２枚目のシートの任意のセルにA3と表示され，取り消し変更された場合は変更後の選択肢のみ表示される）
４，また，選択する項目は変更されないように保護をかけたい。

回答No.10

pauNed · ベストアンサー

>実行できました。
良かったです^ ^

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　　Dim n As Long 'ダブルクリックしたセル位置からグループを決める整数型変数
　　Dim v As Variant 'Variant型変数。書き出し位置の情報を格納する
　　v = Range("Z1:Z60").Value '■書き出し位置が入力してある対照表の範囲
　　'↓Target＝ダブルクリックしたセル。これがRange("A1:Y12")になければ実行しない
　　If Intersect(Target, Range("A1:Y12")) Is Nothing Then Exit Sub
　　'↓シート保護解除
　　Unprotect
　　'↓既定のダブルクリック動作をCancelする
　　Cancel = True
　　'↓With...End With間、Targetに対する記述をまとめ
　　With Target
　　　　'↓Targetの列に4を足したものを5で割った整数に、行から1を引き5をかけたものを _
　　　　 足すと各グループに1～60の数字を割り当てる事ができる
　　　　n = (.Column + 4) \ 5 + (.Row - 1) * 5
　　　　'↓Sheets("シート２")の書き出しセルの値にTargetの値をセットする。 _
　　　　 グループ＝ n であれば、位置情報を格納した配列 n 番目
　　　　Sheets("シート２").Range(v(n, 1)).Value = .Value '■"シート２"は実際のシート名に変更要
　　End With
　　'↓○シェイプ n の位置をダブルクリックしたセル位置に【移動】
　　With Shapes(n)
　　　　.Left = Target.Left + 2
　　　　.Top = Target.Top + 2
　　End With
　　'↓シート保護
　　Protect
End Sub

補足

本当にありがとうございます。
ＶＢＡについては，pauNed様に指導を受けたおかげで"こんなことも出来るんだぁ"って事が分かり，これからコツコツ勉強していきたいと思えるようになりました。また，説明を加えていただいたことにより，コードの意味も何となく理解できました。
しかし，前記の流れや考え方は何となく理解は出来るのですが，実際のコードを書くとなると上手くいきません。。。最後までご迷惑をおかけしますが，お付き合いのほどよろしくお願いいたします。

実際の表のグループごとの参照のされ方ですが，以下のようになっております。
シート１のD9：H9から一つ選択され○が付きシート２のC5に表示されます。
同様にシート１のC10：H10がシート２のC7，D11:H11がC9，C12:H12がC11，C13:H13がC13，C14:H14がC15，C15:H15がC17，C16:H16がC19，C18:E18がC23，C19:E19がC25
I12:N12がE11，I13:N13がE13，I20:K20がE27
O11:T11がG9，O15:T15がG17，O16:T16がG19，O17:S17がG21
U11:Z11がI9，U15:Z15がI17，U16:Z16がI19，U17:Y17がI21
AA11：AF11がK9，AA15:AF15がK17，AA16:AF16がK19，AA17:AE17がK21
となっており，合計２５のグループで構成され表上では抜けていたり結合されたセルもあります。（セルの保護範囲はシート１のC9:AF20）
「Sheets("シート２")の書き出しセルの値にTargetの値をセットする。」上記のような表の場合は，先ほどのようにシート１の任意のセルにどのように表記すればよろしいのでしょうか？
また，他のBOOKでは○をつけるコードを↓のようにしていたのですが，これに先のコードを加えて，選択した項目のシート２へのコピーは出来ませんでしょうか？
標準モジュールに↓
Sub MeDEL()
On Error Resume Next
ActiveSheet.Shapes(Application.Caller).Delete
End Sub
シート１に↓
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sh As Shape
Cancel = True
With Target
Set sh = Me.Shapes.AddShape(msoShapeOval, .Left, .Top, .Width, .Height)
sh.Fill.Visible = msoFalse
sh.OnAction = "MeDEL"
ActiveCell.Offset(1, 0).Select
End With
End Sub
当初よりこのように質問を書ければ良かったのですが，質問の仕方が下手でまたまたご迷惑をおかけいたしますが，よろしくお願いします。

回答No.11

pauNed

こんにちは。No.10補足へのレスです。
…が、少し自分で考えましょうね^ ^
今までのレスが参考にならないでしょうか？
代行を受けてるわけじゃありませんからね。要件変わってますし。
結合されたセルがあったり、CなのかDなのか？１グループセル６個？
それに、
>これに先のコードを加えて
という事であれば、私のアドバイスは役に立ってない事になりますね？

ただ、規則性があるので最後にヒントです。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　　Dim r As Long, c As Long
　　If Intersect(Target, Range("C9:H16,C18:H19,I12:N13,I20:N20,O11:AF11,O15:AF17")) _
　　　　Is Nothing Then Exit Sub
　　Cancel = True
　　With Target
　　　　r = .Row * 2 - 13
　　　　c = ((.Column + 3) \ 6) * 2 + 1
　　　　MsgBox Sheets("sheet2").Cells(r, c).Address(0, 0)
　　End With
End Sub
では。がんばってください。

お礼

まったくその通り。。。お恥ずかしいかぎりです。
教えていただいたものを参考に何とか考えたいと思います。
いろいろありがとうございました。

回答No.9

pauNed

ごめんなさい。間違えました。
Private Sub Worksheet_BeforeDoubleClick...の
　　With Shapes(1)
　　　　.Left = Target.Left + 2
　　　　.Top = Target.Top + 2
　　End With
は
　　With Shapes(n)
　　　　.Left = Target.Left + 2
　　　　.Top = Target.Top + 2
　　End With
です。

回答No.8

pauNed

こんにちは。No.7補足へのレスです。
[winXP/xl2003]の環境でも動作確認しました。でもそちらで動かない事にはしょうがないですね。

Sheets("テスト")がすでにできているBookで、
標準モジュールに以下コードをコピーペーストして、１回実行してみてください。

Sub test()
　　Dim n As Long
　　Dim s As Shape
　　With Sheets("テスト")
　　　　.Unprotect
　　　　For Each s In .Shapes
　　　　　　s.Delete
　　　　Next s
　　　　For n = 1 To 60
　　　　　　With .Shapes.AddShape(msoShapeOval, .Range("z1").Left + 2, 2, 18, 18)
　　　　　　　　.Name = "oval" & n
　　　　　　　　.Fill.Visible = msoFalse
　　　　　　End With
　　　　Next n
　　End With
End Sub

セルZ1に○がつくられませんか？
つくられていれば、その○を選択してください。
数式バーの左の名前ボックスにシェイプの名前が表示されると思います。
ovalX　（xは1～60までの数字）になっていませんか？
○ができていない時は、面倒ですが、セル１コ分くらいの大きさの○シェイプを手作業でつくってみてください。
まず、１コだけつくって、それを選択し、名前ボックスに oval1 と入力してください。

その状態で、セルA1をダブルクリックしてみてください。それでもエラーが出るでしょうか？
エラーが出る場合は

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　　Dim n As Long
　　If Intersect(Target, Range("A1:Y12")) Is Nothing Then Exit Sub
　　Unprotect
　　Cancel = True
　　With Target
　　　　n = (.Column + 4) \ 5 + (.Row - 1) * 5
　　　　Range("AA1:AE12").Cells(n).Value = .Value
　　End With
　　With Shapes(1)
　　　　.Left = Target.Left + 2
　　　　.Top = Target.Top + 2
　　End With
　　Protect
End Sub

に差替えてみてください。

以上で問題なく動作した時の話ですが、
>シート2のセルに規則性がない場合
全く規則性はないですか？
その場合、No.4さんが書かれていたように、対照表を準備する事になります。
例えば、シート１のZ1:Z60に、各グループごとの書き出しセルのアドレスを入力してください。
Z1に A1... Z2に B2...など。
その準備をした後に、下記に差替えればいいと思うのですが。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　　Dim n As Long
　　Dim v
　　v = Range("Z1:Z60").Value '■書き出し位置が入力してある対照表の範囲
　　If Intersect(Target, Range("A1:Y12")) Is Nothing Then Exit Sub
　　Unprotect
　　Cancel = True
　　With Target
　　　　n = (.Column + 4) \ 5 + (.Row - 1) * 5
　　　　Sheets("シート２").Range(v(n, 1)).Value = .Value '■"シート２"は実際のシート名に変更要
　　End With
　　With Shapes(1)
　　　　.Left = Target.Left + 2
　　　　.Top = Target.Top + 2
　　End With
　　Protect
End Sub

お礼

pauNedさん!!
夜中にも拘らずご回答ありがとうございます。
また，親切丁寧なご説明をいただきまして何とか頑張りたいと思います。
頂きましたコードで実行できました。
対照表を作成し実際に表に当てはめたいと思います。
また，何かありましたらよろしくお願いいたします。

回答No.7

pauNed

こんにちは。No.6補足へのレスです。
1)状況が今ひとつ掴めていなかったので、サンプルシートを作った。
2)誰でも同じように検証できるよう、サンプルシートを作るコードを提示した。【Sub サンプル準備】
3)手順は、『例えば』新規Bookを準備する。
4)そのBookの標準モジュールに【Sub サンプル準備】をコピーペーストする。
5)【Sub サンプル準備】を１回だけ実行する。
6)"テスト"という名前のシートができる。（←■できませんでしたか？）
7)できた『"テスト"という名前のシートのシートモジュールに』
　【Private Sub Worksheet_BeforeDoubleClick】をコピーペーストする。
8)"テスト"シートをDoubleClickしてみる。○の動きとAA1:AE12の範囲を確認してみる。

…という意味でした。言葉足らずですみません。どこでつまずかれてますか？
[win2000sp4/xl2000sp3]の環境で動作確認しています。
ポイントは、
>○をグループ数（60個）用意しておけば、比較的簡単にまとめられそうです。
という発想だけなのですが。

>１枚目に丸がついた項目が２枚目の任意のセルに表示される
ようにするには、ご自分の状況にあわせて【Private Sub Worksheet_BeforeDoubleClick】のコードを修正しなければなりません。

補足

お忙しい中何度もありがとうございます。
当方、零細企業のため現場にも出なければならず、ご返事遅れましたことお詫びいたします。今しばらくお付き合いいただけたら幸いです。
また、使用環境はwinXP/xl2003です。
テストサンプルを新規Book上にコピペしましたところ、AA1:AE12にコピーはされグループごとの表示はするのですが、選択項目に○はつきませんでした。（１０行目のところでエラーとなります）

また、実設定を申しますとシート１にある表は６０グループありますが、実際の入力は２５グループほどとなっており、シート２にある表の指定セルに選択された数字（AグループであればA1とか）がコピーされるというものです。そこで、問題ですが、シ－ト１で選択される数字がコピーされるシート2のセルに規則性がない場合はグループごとの設定となると思いますが、どのようにコードを表示するのでしょうか？
当方、VBA初心者でただいま、参考書を手に奮闘しておりますが、頂きましたコードの理解には至っておらず、ご迷惑をおかけいたしますが、よろしくお願いいたします。

回答No.6

pauNed

こんにちは。
『グループ』というのが意味がわかりませんでした。
A1:E1のセル範囲に、A1,A2...A5とあって、それを１つのグループとしている、という意味ですか？
もし、セル1つにA1などの文字があるのなら、○をグループ数（60個）用意しておけば、
比較的簡単にまとめられそうです。

サンプルシートを作成して、試してみました。
標準モジュールに↓をコピーペーストして１回だけ実行してみてください。
'---------------------------------------------------------------------
Sub サンプル準備() '■１回だけ実行。Sheets("テスト")を追加します。
　　Dim r As Long, c As Long, n As Long
　　Dim ri As Range

　　Application.ScreenUpdating = False
　　With Sheets.Add
　　　　.Name = "テスト"
　　　　.Range("aa1:ae12").BorderAround xlContinuous
　　　　With .Range("a1:ae12")
　　　　　　.ColumnWidth = 4
　　　　　　.RowHeight = 22.5
　　　　　　.VerticalAlignment = xlCenter
　　　　　　.HorizontalAlignment = xlCenter
　　　　　　With .Resize(, 25)
　　　　　　　　.BorderAround xlContinuous
　　　　　　　　c = 1
　　　　　　　　For Each ri In .Cells
　　　　　　　　　　r = r + 1
　　　　　　　　　　If r = 6 Then r = 1: c = c + 1
　　　　　　　　　　ri.Value = .Cells(r, c).Address(0, 0)
　　　　　　　　Next ri
　　　　　　　　For n = 5 To 20 Step 5
　　　　　　　　　　.Columns(n).Borders(xlEdgeRight).LineStyle = xlContinuous
　　　　　　　　Next n
　　　　　　End With
　　　　End With
　　　　For n = 1 To 60 '■oval1からoval60まで準備しておく
　　　　　　With .Shapes.AddShape(msoShapeOval, .Range("z1").Left + 2, 2, 18, 18)
　　　　　　　　.Name = "oval" & n
　　　　　　　　.Fill.Visible = msoFalse
　　　　　　End With
　　　　Next n
　　End With
　　Application.ScreenUpdating = True
End Sub
'---------------------------------------------------------------------

以下が本題です。
作成されたSheets("テスト")のシートモジュールにコピーペーストしてください。
あくまでサンプルですから、修正しなければ使えません。コード作成の参考になれば。
'---------------------------------------------------------------------
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　　Dim n As Long
　　If Intersect(Target, Range("A1:Y12")) Is Nothing Then Exit Sub
　　Unprotect
　　Cancel = True
　　With Target
　　　　n = (.Column + 4) \ 5 + (.Row - 1) * 5
　　　　Range("AA1:AE12").Cells(n).Value = .Value
　　End With
　　With Shapes("oval" & n)
　　　　.Left = Target.Left + 2
　　　　.Top = Target.Top + 2
　　End With
　　Protect
End Sub
'---------------------------------------------------------------------
何か勘違いしてたらごめんなさい。

補足

おはようございます!!
返事が遅れまして申し訳ありませんでした，また，お忙しい中ありがとうございました。
『A1:E1のセル範囲に、A1,A2...A5とあって、それを１つのグループとしている、という意味ですか？』についてですが，A1:A5がひとつのグループで，それが同様にB1:B5，C1:C5，D1:D5.....としてそれぞれのグループ内でひとつの項目（例えばA1:A5のグループでA1を選択すれば○で囲み，そのほかのA2,A3,A4,A5のどれかに変更されれば，A1の○がはずれ，選択した方のみ囲まれる）で排他的な処理を実行できればと考えております。【説明が下手で申し訳ありません。】
頂きましたコードを試させて頂きましたが，シートモジュール１０行目の「With Shapes("oval" & n)」でエラーになってしまいます。
サンプルの設定の仕方が間違っていたのでしょうか？
（Sheets１にコピペしてSheets２の名前をテストとするのでしょうか？）

回答No.5

tarodaro

>囲んだものを別シートに表示することが出来ずにおります
"囲む"？
worksheets("シート名").cells(1, 1).value = 2
>どのセルに表示するかを表で表せばよろしいのでしょうか？
そうです。が、計算で求められるのであれば、当然不要です
>対照表はどこに作ればいいのでしょうか？
目立たないところｗ

回答No.4

tarodaro

選択したセルが属するグループの範囲(range)を計算で求めます
グループ全体をクリアして選択したセルに丸印を書き込みます
シート２への書き込みで、アドレスに規則性がない場合は
対照表を用意します。選択の可否はこの表で設定してもいいし、
背景色などで判断することも出来ます
>保護をかけたい
unprotect して cancel してから書き込み、protect します
特に難しくはない筈ですが、質問（？）を継続する場合は、
コード化できた部分だけでも掲示するようにして下さい

補足

ご回答ありがとうございます。
何とか出来る部分だけ（間違いも多いと思いますが。。。）コードを書いてみます。
現在は，ダブルクリックにより選択肢を○で囲むことは可能ですが（シート上のどのセルにも○が表示されてしまう状態。），囲んだものを別シートに表示することが出来ずにおります。
また，"対照表を用意する"というのは選択範囲から選ばれたものをどのセルに表示するかを表で表せばよろしいのでしょうか？
また，対照表はどこに作ればいいのでしょうか？

回答No.3

S-Fuji

残念ながら、それだけの内容を、このようなサイトで全て解説出来ません。
まずは、VBAの解説書を数冊買い込んで勉強しましょう。
１冊だけでは、解説が不十分であったりしますし、所により分かりにくい部分も
他の本では分かりやすかったりします。
また、VBAやExcelを解説しているサイトも多々有ります。
そちらの参考にしてみてください。
http://www.fuji.ne.jp/~excelyou/
http://www2.odn.ne.jp/excel/
http://excelfactory.net/
http://www.asahi-net.or.jp/~ef2o-inue/top01.html

回答No.2

tols777

初めまして！では無いですが。。。
質問者様がマルチポストで投稿されていたので私が回答した内容が削除されました。

参考URLだけ再度載せておきます。

参考URL：

http://www.moug.net/

お礼

ご丁寧にありがとうございます。
参考にさせていただきます。

回答No.1

kokorone

考え方；
VBAの知識はほとんど要らないかもしれません。
オプションボタンを使えば、グループ内の排他制御ができます。
http://arena.nikkeibp.co.jp/tec/excel/20040308/107545/
これで、グループ内の何番目が選択されたかもわかりますので、
その結果から、選択された項目の文字列も表示できます。

お礼

早速のご回答ありがとうございます。
今回，社内の様式が決められておりまして，リストボックスやボタンの設定が出来ずにおります。（選択項目を○で表示するよう決められている。）
よろしくお願いいたします。