Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7534 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【38464】セル内容のコピー 西本 06/6/3(土) 15:27 質問[未読]
【38469】Re:セル内容のコピー Kein 06/6/3(土) 16:28 回答[未読]
【38481】Re:セル内容のコピー 西本 06/6/3(土) 22:58 質問[未読]
【38483】Re:セル内容のコピー Kein 06/6/3(土) 23:30 回答[未読]
【38501】Re:セル内容のコピー 西本 06/6/5(月) 13:03 お礼[未読]
【38464】セル内容のコピー
質問  西本  - 06/6/3(土) 15:27 -
引用なし
パスワード
   はじめまして。

あるセルに値を代入したら、関連付けられた別のセルにも同様の値を入れたいと思っています。

例えば、セルA1に"AAAAA"と入力した時（入力はプルダウンによる）、セルA2〜A5までを"AAAAA"で自動で埋めるようにしたいです。
ここで、セルA2〜A5も独自に入力（プルダウンによる）できるようにしたいのですが、（A2〜A5による部分入力、A1による一括入力を実現したい）これが実現できずに困っています。

A2〜A5に IF(A1<>"",A$1,"") のようにすると、A2〜A5に入力した時、式が消えてしまいできませんでした。

このようなことは可能でしょうか。
よろしくおねがいします。
【38469】Re:セル内容のコピー
回答  Kein  - 06/6/3(土) 16:28 -
引用なし
パスワード
   A1の値が変わる度に、いちいちマクロによってA2:A5に入力規則を削除〜追加する、
というのは回りくどいので、まず初めに手作業で A1:A5 を選択して入力規則を
設定しておいて下さい。そしてそのシートのシートモジュールに

Private Sub Worksheet_Change(ByVal Target As Range)
　 With Target
　　　If .Address <> "$A$1" Then Exit Sub
　　　If .Count > 1 Then Exit Sub
　　　If Not .Validation.Value Then Exit Sub
　　　Application.EnableEvents = False
　　　Range("A2:A5").Value = .Value
　　　Application.EnableEvents = True
　 End With
End Sub

を入れて、A1 と A2:A5 でそれぞれ値を変更して、テストして下さい。
【38481】Re:セル内容のコピー
質問  西本  - 06/6/3(土) 22:58 -
引用なし
パスワード
   Kein 様 ありがとうございます。

教えていただいたとおりにすると実現できました。
しかし、複数のセルに同様のことをしようとして（セルA2〜A5にA1を反映、B2〜B5にB1を反映・・・・）これを応用しようとしたのですが（以下）、どうしてもできませんでした。

教えていただいたソースも理解できていないのですが、何が悪いのでしょうか。

Private Sub Worksheet_Change(ByVal Target As Range)
　 With Target
　　　If .Address <> "$A$1" Then Exit Sub
　　　If .Count > 1 Then Exit Sub
　　　If Not .Validation.Value Then Exit Sub
　　　Application.EnableEvents = False
　　　Range("A2:A5").Value = .Value
　　　Application.EnableEvents = True
　　　
　　　If .Address <> "$B$1" Then Exit Sub
　　　If .Count > 1 Then Exit Sub
　　　If Not .Validation.Value Then Exit Sub
　　　Application.EnableEvents = False
　　　Range("B2:B5").Value = .Value
　　　Application.EnableEvents = True
　　　
　　　If .Address <> "$C$1" Then Exit Sub
　　　If .Count > 1 Then Exit Sub
　　　If Not .Validation.Value Then Exit Sub
　　　Application.EnableEvents = False
　　　Range("C2:C5").Value = .Value
　　　Application.EnableEvents = True
　 End With
End Sub
【38483】Re:セル内容のコピー
回答  Kein  - 06/6/3(土) 23:30 -
引用なし
パスワード
   複数のセルを対象にするなら、先に回答したような単純なコードを
ずらずらと並べるだけではうまくいきません。ちょっと判定条件を
工夫する必要があります。こんな感じです。

Private Sub Worksheet_Change(ByVal Target As Range)
　 If Intersect(Target, Range("A1:C1")) _
　　Is Nothing Then Exit Sub
　 With Target
　　　If .Count > 1 Then Exit Sub
　　　If Not .Validation.Value Then Exit Sub
　　　Application.EnableEvents = False
　　　.Offset(1).Resize(4).Value = .Value
　　　Application.EnableEvents = True
　 End With　　
End Sub
【38501】Re:セル内容のコピー
お礼  西本  - 06/6/5(月) 13:03 -
引用なし
パスワード
   Kein 様
ありがとうございました。

以下のように、Kein様のソースを応用させて頂くことにより、
様々なパターンに応用することができました。

Private Sub Worksheet_Change(ByVal Target As Range)
　　Dim ofs As Integer
　　Dim res As Integer
　　Dim flg As Integer
　　
　　flg = 0
　　If Intersect(Target, Range("C5:E5")) Is Nothing Then
　　Else
　　　　ofs = 2
　　　　res = 12
　　　　flg = 1
　　End If
　　If Intersect(Target, Range("C6:E6")) Is Nothing Then
　　Else
　　　　ofs = 13
　　　　res = 7
　　　　flg = 1
　　End If
　　If Intersect(Target, Range("C26:E26")) Is Nothing Then
　　Else
　　　　ofs = 1
　　　　res = 6
　　　　flg = 1
　　End If
　　If flg = 0 Then
　　　　Exit Sub
　　End If

　　With Target
　　　　If .Count > 1 Then Exit Sub
　　　　If Not .Validation.Value Then Exit Sub
　　　　Application.EnableEvents = False
　　　　.Offset(ofs).Resize(res).Value = .Value
　　　　Application.EnableEvents = True
　　End With
End Sub
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
7534 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free