『入力規則のセルへデフォルト値を入力する方法』（ぱむ）
 
 はじめて質問を致します。
 Excel2003利用下で以下の内容を実現する方法はありませんか？
 セルC1には入力規則が設定されており、○，◇，☆、がリストで設定されています。
 セルA1に ☆ が入力されているとします。
 セルB1に入力があった場合、セルC1にA1の値を書き込める、またセルB1の入力値をデリートした場合、セルC1の値も空白に戻す。 の様なことを行いたいのです。
  セルC1にIF関数をいれてセルB1の値から条件分岐させるという方法もあるかと存じますが、セルC1には数式ではなく、値を書き込みたいのです。
  尚、列B,Cの構成は列D以降も繰り返し出て参りますし、行2以降も行1の内容をオートフィルする予定です。
  どなたかご教示頂けますと有難く存じます。 何卒宜しくお願い致します。

----
 ＞セルC1には数式ではなく、値を書き込みたいのです
 
 一般機能では無理です。
 
 マクロでもいいのですか？
 （私は書きませんけど）
 
 (半平太) 2013/02/11(Mon) 17:03
----
早速のご返信有難う御座います。
 
＞マクロでもいいのですか？
はい。マクロでも構いません。
 
VBAに関しては初心者でして、勉強しながら試行錯誤しているのですが、
なかなかご質問させて頂きました内容を具現化するコードを書けないもので、
先輩方のお知恵を拝借させて頂きたく書き込みを致しました。
 
引き続き、お知恵を頂けますと有難く存じます。
 
（ぱむ）
----
 A1 に　○，◇，☆　以外のものが入っていてもかまわずにC1にセットする手抜きコード。
 (A1の値がリスト内にあるかどうかをチェックすることもできるけど）

 シートのタブを右クリックして、コードの表示を選んででてきたところに以下を貼り付け。

 Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("B1")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    If Len(Range("B1").Value) = 0 Then
        Range("C1").ClearContents
    Else
        Range("C1").Value = Range("A1").Value
    End If
    Application.EnableEvents = True
 End Sub

 (ぶらっと)
----
 複数入力がありそうな雰囲気なので…B、D、F…と偶数列を操作した時に、その右隣りへ結果を出します。
 A列が入力規則にマッチしていない、またはB列の入力が空白である場合、C列は空白を返します。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Mylist As String, adr As String
With Target
    If (.Columns.Count > 1) + (.Column Mod 2 <> 0) Then Exit Sub
    Mylist = "{""○"", ""◇"", ""☆""}" '入力規則リスト
    adr = Me.Range("A" & .Row).Resize(.Count, 1).Address
    Application.EnableEvents = False
        .Offset(, 1).Value = Evaluate("if(isna(match(" & adr & "," & Mylist & ",0))+(" & .Address & "=""""),""""," & adr & ")")
    Application.EnableEvents = True
End With
End Sub
　
(Jera)
----
ぶらっとさん　Jeraさん
有難う御座います。

A1セルの値は別シートから抽出して書き込むようなマクロ処理を行っておりまして、
入力規則のリスト以外の値は書き込まれない内容になっておりますので、その部分
の精査は必要御座いません。
 
＞Jeraさん
 
複数入力を想定したコードを頂き有難う御座います。
まず頂いたコードを理解出来る様に勉強してみます。
以下、私がコード内容を十分に理解出来ていないものとしてお読み下さい。
B列・C列の様な構成を、F列・G列の様に列数を等間隔で設定する場合、
また行番号に関しても等間隔で設定してく場合は、
offsetで対象（例だとC1)を動かしていくのでしょうか？
  
勉強不足で分かり難い内容であれば申し訳御座いません。
Worksheet_ChangeならびにOffsetを今一つ理解出来ていない点も御座いますが、頂いた内容をもとに自分なりに試行錯誤してみたいと思います。
またアドバイスを頂けますと有難く存じます。
何卒宜しくお願い致します。
 
（ぱむ）
----
 >B列・C列の様な構成を、F列・G列の様に列数を等間隔で設定する場合、 
 >また行番号に関しても等間隔で設定してく場合は、

 このような場合もコピー元はA1（あるいはA列)固定？
 それとも　入力規則の設定してあるセルの●個右のセルに入力があったばあい、そのさらに●個右のセルの値を
 入力規則が設定してあるセルに転記？

 (ぶらっと)
  

----
 >B列・C列の様な構成を、F列・G列の様に列数を等間隔で設定する場合、 
 >また行番号に関しても等間隔で設定してく場合は、 
 >offsetで対象（例だとC1)を動かしていくのでしょうか？ 

 worksheet_changeイベントは、セルを編集した際に自動的に書かれたマクロが
 その都度実行されるというものです。
 ルールに従って勝手に毎回処理されますので、
 そのルール通りにコードが書けていれば設定・変更する必要はありません。

 私の書いたものはコピー元はA列が固定で、BC列と同じ構成の列がDE、FG、HIと
 続いているものと仮定しています。
 
 行数は入力した列が偶数列である限り、何行目に入力しても
 複数一括入力（例えば縦方向へコピー貼り付け）しても、その右隣のセルに結果が返されます。
 それ以外の列や、複数列を同時に編集した場合は
 If (.Columns.Count > 1) + (.Column Mod 2 <> 0) Then Exit Sub
 の部分で処理が終わります。（つまり何もされない）

 といった内容のコードです。私もA列固定でいいかは迷いましたし、
 やりたい事ドンピシャでない可能性は大いにあります。

 とにかくまずはコードをシートモジュールへ貼り付け、色々とセルに入力しながら試してみて下さい。
(Jera)
----
 ん・・・・？
 >A1セルの値は別シートから抽出して書き込むようなマクロ処理を行っておりまして、 
 >入力規則のリスト以外の値は書き込まれない内容になっておりますので
 ここの部分今気付いた(；´∀｀)

 ならこれでいいかも？　
Private Sub Worksheet_Change(ByVal Target As Range)
Dim adr As String
With Target
    If (.Columns.Count > 1) + (.Column Mod 2 <> 0) Then Exit Sub
    adr = Me.Range("A" & .Row).Resize(.Count, 1).Address
    Application.EnableEvents = False
        .Offset(, 1).Value = Evaluate("if(" & .Address & "="""",""""," & adr & ")")
    Application.EnableEvents = True
End With
End Sub
　
(Jera)
----
ぶらっとさん　Jeraさん
 
追加でアドバイスを頂きまして有難う御座います。
また、ご返信が遅くなりまして申し訳御座いません。
 
頂いたコードをそのまま使うのは、もし変更があった場合に右往左往してしまいますので
理解出来る様に勉強して,改善を加えながら利用する様にしてみます。
 
Jeraさんおかれましては、細かな説明まで頂きまして有難う御座います。
 
まだまだ未熟者ですので、再度掲示板にて質問をさせて頂くこともあるかと存じますが、
何卒宜しくお願い致します。
 
(ぱむ)