[[20041206151442]] 『入力規則のリストに自動で追加したい』（miu） ページの最後に飛ぶ
[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『入力規則のリストに自動で追加したい』（miu）
いつもお世話になってます。
質問：例えば、B列にリスト範囲を設定し、A１〜A１０のセルに入力規則のリストを設定したとします。 その時、A１〜A１０への入力は通常の作業ではドロップダウンリストで選択するのですが、 A1〜A１０のどれかのセルにB列（リスト範囲）に無い文字を入力した時に、 自動でB列の空欄に文字を追加をする方法って何かありますか？
宜しくお願いします。
B列へはデータを追加するのみで、削除はナシですか？ (INA)
すいません、衝突しました。
作業列（C列）を使う方法ですが、以下のようなことで対応可能でしょうか。 A B C 1 C A 2 X B 2 3 H C 4 Q D 4 5 E 6 F 7 G 8 H 9 I 10 J 11 X 12 Q B11セル=IF(COUNT($C$1:$C$20)<ROW(A1),"",INDEX($A$1:$A$20,SMALL(IF(ISNUMBER($C$1:$C$20),$C$1:$C$20,""),ROW(A1)),1)) として、Shift+Ctrlキー押しながらEnterキーで確定させて配列数式に。 C1セル=IF(A1="","",IF(ISNA(MATCH(A1,OFFSET($B$1,,,COUNTA($B$1:$B$10)),0)),ROW(),"")) として、Shift+Ctrlキー押しながらEnterキーで確定させて配列数式に。 範囲がもっと大きくなったりする場合はマクロが簡単かもしれません。 （川野鮎太郎）
お返事ありがとうございます。
INAさん、削除する場合もあります。削除した時に空欄を自動で詰めれれば良いのですが、詰めれない時は次回追加する時にそこに追加できれば大丈夫です。 ※書いてから気づきました・・・、デリートキーで文字だけを消すのではなくて、セルの削除で上に詰めれば大丈夫ですね・・・。失礼しました。。。m(__)m
川野鮎太郎さん、作業列を使うのは大丈夫なんですがA列の文字を削除してもB列に追加した項目は残したいです。
要望が多くてすみません。。。
ちょっと、追加しました。
（miu)
マクロしかないかも知れませんね。 参考までにこんなのでいけますか・・・？ 該当シートのタブを右クリックして出てきたVBE画面に貼り付けてください。 なお、複数セルのコピペには対応させてません。
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyRow As Long
Dim MyRange As Range
Dim MyC As Double
If Target.Column <> 1 Then Exit Sub
If Target.Count <> 1 Then Exit Sub
MyRow = Range("B1").End(xlDown).Row
Set MyRange = Range("B1").Resize(MyRow, 1)
On Error GoTo ErrorHandler
MyC = Application.Match(Target.Value, MyRange, 0)
Exit Sub
ErrorHandler:
Cells(MyRow + 1, 2).Value = Target.Value
End Sub
（川野鮎太郎）
>削除する場合もあります。 それならＡ列からＢ列にコピーするだけはダメなのでしょうか？ (INA)
すいません。書き忘れていました。 B列のリストを追加するために、名前の定義をしたほうが良いです。 挿入−名前−定義と進み、参照範囲に =OFFSET($B$1,,,COUNTA(B:B)) を入力し、 名前の欄に適当な名前（Listなど）を入れて OK
A列の入力規則で、入力値の種類でリストを選択し、元の値に =List としてください。 To INAさん ＞それならＡ列からＢ列にコピーするだけはダメなのでしょうか？ どうなんでしょう。それだけで良いのかも知れませんね(^_^A; （川野鮎太郎）
お返事ありがとうございます。 試してみたら、うまくできました。 A列からB列にコピーでも良いのですが、手間を省きたかったので。。。 わがままで、すみません・・・。
ちなみに、プログラムの処理がどのように行われているのか理解してみたいのですが、 難しくてよくわかりません。。。宜しければ、解説お願いしても良いですか？ 宜しくお願いします。 （miu)
> A列からB列にコピーでも良いのですが それだったら、マクロの記録を利用すれば、 自動作成されたコードをChangeイベントのプロシージャにコピペすれば ひとまず動くものは出来るでしょう。 (INA)
衝突しました・・・。
えっと、マクロの記録だけではB列にあるかないかの判断は出来ないからの処理ですよね(^_^A;
以下衝突時点で記述していたものです。 えっと・・・あのー・・・説明の苦手なσ(^_^;)にお求めになられるのですね・・・（￣ー￣；Aアセアセ･･･
Option Explicit '明示的な宣言を強制します。
Private Sub Worksheet_Change(ByVal Target As Range) 'ワークシートのチェンジイベント
Dim MyRow As Long '変数の宣言（行の数なのでLong）
Dim MyRange As Range ' 〃 （セル範囲なのでRange）
Dim MyC As Double ' 〃 （Match関数の戻り値で本来はLongかも？）
If Target.Column <> 1 Then Exit Sub '変化したセルが1列目以外は処理を抜ける
If Target.Count <> 1 Then Exit Sub '変化したセルが複数の場合は処理を抜ける
MyRow = Range("B1").End(xlDown).Row 'B1の最下行の行番号をMyRowに代入
Set MyRange = Range("B1").Resize(MyRow, 1) 'B1セルをMyRow行だけ範囲を広げたものをMyRangeに代入
On Error GoTo ErrorHandler 'エラーが出たら、ErrorHandler:（エラー処理ルーチン）から処理を始める
MyC = Application.Match(Target.Value, MyRange, 0) 'VBAでワークシート関数を使うために、Matchの前にApplication.を付ける。
Exit Sub 'Match関数でエラーが出ないってことは、A列に入力した値がB列にあるので処理を抜ける
ErrorHandler: '上で書いたようにMatch関数でエラーが出るってことは、A列に入力した値がB列に無いので以下の処理を行う
Cells(MyRow + 1, 2).Value = Target.Value 'B列の最終行の1行下に入力した値を入れる
End Sub
って感じです。お解りになりますでしょうか。 上記コードの最初の行あたりにブレークポイントを付けて、A列に何かを入力 F8（ファンクションキー）でステップインしながら確認すると動きが判るかもしれません＾＾ http://www.asahi-net.or.jp/~ef2o-inue/vba_k/sub04_030.html この辺がわかり易いかな。
（川野鮎太郎）
早速、詳しい解説本当にありがとうございます！ 用語が難しいのと、初心者には複雑な処理をされてて、すぐにはわかりそうにないんですけど調べながら理解してみようと思います。 ありがとうございました。
すみません！追加お願いします。 =OFFSET($B$1,,,COUNTA(B:B))も教えてもらっても良いですか？特に「,,，」ってなんですか？
（miu)
＞=OFFSET($B$1,,,COUNTA(B:B))も教えてもらっても良いですか？
(ノ∀｀)アイター その方法はManちゃんの受け売りなんですよね(^_^A;
結構便利で重宝してます＾＾
ワークシートのB列以外に =OFFSET($B$1,,,COUNTA(B:B)) を入れて、そのセルを選択した状態で
関数貼り付けボタン（fx）を押してみてください。そうすると以下のようになります。
基準セルがB1、行数、列数が無いので,,,で区切り高さがB列の入力があるセル数と言う事になります。
なのでB列の途中のセルに空白があると、リストには空白セル数分だけ下の方がリストから外れますので注意が必要です。
（川野鮎太郎）
絵付きですごくよくわかりました！ありがとうございました。
それで、使用したいファイルに今回のプログラムを使用してみたのですが、 すみません、実は 「2004/12/04(土)16:56 『条件により、セルを結合及びリスト設定』（miu）」 のプログラムに今回のプログラムを組み込みたかったのですが 自分で組み込んでみたところ、リストに追加がされません。。。 ちょっと複雑になりすぎてきたのですが、どこが間違ってるか見ていただけませんでしょうか？お願いします。
(miu)
Option Explicit '明示的な宣言を強制します。
Private Sub Worksheet_Change(ByVal Target As Range) 'ワークシートのチェンジイベント
'入力規則のリスト追加の変数宣言 Dim MyRow As Long '変数の宣言（行の数なのでLong） Dim MyRange As Range ' 〃 （セル範囲なのでRange） Dim MyC As Double ' 〃 （Match関数の戻り値で本来はLongかも？）
'入力規則と結合の変数宣言 Dim r As Range Dim a As Long Dim b As Long
'シートの保護解除 ActiveSheet.Unprotect
'現在のセルのアドレス取得（最後に、隣のセルに移動する為） a = ActiveCell.Row b = ActiveCell.Column
'入力規則と結合（A13：A35に入力があれば、C13：N13 〜 C35：N35を各々結合して入力規則のリスト設定。
'リスト範囲はｙ列（名前定義：list）
If Application.Intersect(Target, Range("A13:A35")) Is Nothing Then Exit Sub
For Each r In Target '変更されたセル全てに対して処理
If r.Value = "" Then '空欄の時
With Range(Cells(r.Row, 3), Cells(r.Row, 14))
.MergeCells = False
.Font.Size = 11 '---フォント11にする
.Value = ""
.Font.Bold = False '---太字にしない
.ShrinkToFit = False '---縮小表示にしない
With .Validation '---結合解除
.Delete
.Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator:=xlBetween
.IgnoreBlank = True
.InCellDropdown = True
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With
End With
Else '空欄では無い時
With Range(Cells(r.Row, 3), Cells(r.Row, 14))
.Merge
.Font.Size = 20 '---フォント20にする
.Value = ""
.Font.Bold = True '---太字にする
.ShrinkToFit = True '---縮小表示にする
With .Validation '---結合
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=list"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.IMEMode = xlIMEModeOn
.ShowInput = False
.ShowError = False
End With
End With
'入力規則のリスト追加(C列が選択欄、ｙ列がリスト範囲欄）
If Target.Column <> 3 Then Exit Sub '変化したセルがc列目以外は処理を抜ける
If Target.Count <> 1 Then Exit Sub '変化したセルが複数の場合は処理を抜ける
MyRow = Range("y1").End(xlDown).Row 'y1の最下行の行番号をMyRowに代入
Set MyRange = Range("y1").Resize(MyRow, 1) 'y1セルをMyRow行だけ範囲を広げたものをMyRangeに代入
On Error GoTo ErrorHandler 'エラーが出たら、ErrorHandler:（エラー処理ルーチン）から処理を始める
MyC = Application.Match(Target.Value, MyRange, 0) 'VBAでワークシート関数を使うために、Matchの前にApplication.を付ける。
Exit Sub 'Match関数でエラーが出ないってことは、b列に入力した値がy列にあるので処理を抜ける
ErrorHandler: '上で書いたようにMatch関数でエラーが出るってことは、b列に入力した値がy列に無いので以下の処理を行う
Cells(MyRow + 1, 25).Value = Target.Value 'y列の最終行の1行下に入力した値を入れる
End If
Next r
'数式の入ってるセルの保護
ActiveSheet.Select
Cells.Select
With Selection
.Locked = False
.SpecialCells(xlCellTypeFormulas).Locked = True
End With
ActiveSheet.Protect
'セルの移動(入力したセルの隣のセルに移動 Cells(a, b + 1).Select
End Sub
あのぅ。。全くななめ横からお邪魔します。
＞=OFFSET($B$1,,,COUNTA(B:B))も教えてもらっても良いですか？
それも、ここだけに限定なんですが、、
VBAをされている方ならこちらの方がわかりやすいかな？っと思いまして、、
「しっちょる」って言われたらそれまでなんですけどね、、
結局ワークシートのOFFSETの後ろ半分はVBAのResizeのことなんですね。
私は、いつもそんな感じでつかってます。
ということは、ある意味
↓これと
=OFFSET(A1,1,1,1,1)
↓これは
Range("A1").Offset(1,1).Resize（1,1）
同じことみたいなもんなんですね。。余計わからなくなったりして(^^;;;
で、なにがいいたいかというと、、ただそれだけです。。
ではでは、
ちょっと、軽く突っ込まないと出番がない
SoulManちゃんでしたぁv(=∩_∩=)v
前回のものが良く理解できていませんが、上記のコードで言えば ＞A13：A35に入力があれば、C13：N13 〜 C35：N35を各々結合して ってなってますが、当初私が書いたコードを修正して、 If Target.Column <> 3 Then Exit Sub で使われてるようですね。 てことは、A列の数値を変えても処理が抜けるのでダメなはずです。
できれば、全体的な流れをどのような処理されたいのか説明願えますか。 （川野鮎太郎）
SoulManさん、VBAは初心者なので余計分からなかったりします・・・。（＾＾；） 今回のも、ここで先生方に教えて頂いたプログラムを組み合わせて使用する程度の知識しかありません。。。なるべく、教えて頂いたプログラムは理解しようとがんばってるのですが、まだまだって感じなもので。。。わざわざ補足して頂いて申し訳なかったです。<m(__)m>
川野鮎太郎さん、全体的な流れを説明させてもらいますと、 まず、セルA13に、ある数字が入力されるとセルC13〜N13を結合して、 入力規則のリスト設定で、y列（$y:$y)を範囲として設定します。 これに当てはめたいのが、A13〜A35まであります。また、入力が無い時は結合も入力規則も解除になります。 そして、結合したC列で先程のリスト範囲ｙ列に無い物を入力した時に 新しくリストに加えるようにしたいのが、大まかな流れになります。
こんな説明でわかりますでしょうか？
（miu）
流れはコードをステップインしていったらなんとなく判りました。 ただ、＞b列に入力した値がy列にあるので処理を抜ける になってますけど、 A列の間違いでしょうか？ 単純な間違いなら以下でいけますでしょうか。 Option Explicit '明示的な宣言を強制します。 Private Sub Worksheet_Change(ByVal Target As Range) 'ワークシートのチェンジイベント
'入力規則のリスト追加の変数宣言 Dim MyRow As Long '変数の宣言（行の数なのでLong） Dim MyRange As Range ' 〃 （セル範囲なのでRange） Dim MyC As Double ' 〃 （Match関数の戻り値で本来はLongかも？） Dim MyCount As Long
'入力規則と結合の変数宣言 Dim r As Range Dim a As Long Dim b As Long
'シートの保護解除 ActiveSheet.Unprotect
'現在のセルのアドレス取得（最後に、隣のセルに移動する為）
a = ActiveCell.Row
b = ActiveCell.Column
MyCount = 0
'入力規則と結合（A13：A35に入力があれば、C13：N13 〜 C35：N35を各々結合して入力規則のリスト設定。
'リスト範囲はｙ列（名前定義：list）
If Application.Intersect(Target, Range("A13:A35")) Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each r In Target '変更されたセル全てに対して処理
MyCount = MyCount + 1
If r.Value = "" Then '空欄の時
With Range(Cells(r.Row, 3), Cells(r.Row, 14))
.MergeCells = False '---結合解除
.Font.Size = 11 '---フォント11にする
.Value = ""
.Font.Bold = False '---太字にしない
.ShrinkToFit = False '---縮小表示にしない
.Validation.Delete '---入力規則の削除
End With
Else '空欄では無い時
With Range(Cells(r.Row, 3), Cells(r.Row, 14))
.Merge '---結合
.Font.Size = 20 '---フォント20にする
.Value = ""
.Font.Bold = True '---太字にする
.ShrinkToFit = True '---縮小表示にする
With .Validation '---結合
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=list"
.IgnoreBlank = True
.InCellDropdown = True
.IMEMode = xlIMEModeOn
End With
End With
'入力規則のリスト追加(C列が選択欄、ｙ列がリスト範囲欄）
MyRow = Range("y1").End(xlDown).Row 'y1の最下行の行番号をMyRowに代入
Set MyRange = Range("y1").Resize(MyRow, 1) 'y1セルをMyRow行だけ範囲を広げたものをMyRangeに代入
On Error GoTo ErrorHandler 'エラーが出たら、ErrorHandler:（エラー処理ルーチン）から処理を始める
MyC = Application.Match(Cells(a + MyCount - 1, 1).Value, MyRange, 0) 'VBAでワークシート関数を使うために、Matchの前にApplication.を付ける。
GoTo Line01 'Match関数でエラーが出ないってことは、A列に入力した値がy列にあるので処理をLine01に移す
'上で書いたようにMatch関数でエラーが出るってことは、A列に入力した値がy列に無いので以下の処理を行う
ErrorHandler:
Cells(MyRow + 1, 25).Value = Cells(a + MyCount - 1, 1).Value 'y列の最終行の1行下に入力した値を入れる
Line01:
End If
Next r
'数式の入ってるセルの保護
With Cells
.Locked = False
.SpecialCells(xlCellTypeFormulas).Locked = True
End With
ActiveSheet.Protect
'セルの移動(入力したセルの隣のセルに移動 Cells(a, b + 1).Select Application.EnableEvents = True End Sub
※必要なさそうなコードは削除させていただきました。 （川野鮎太郎）
川野鮎太郎さん、ありがとうございます。 コメント部分の修正が間違っていたので申し訳なかったのですが、 ＞b列に入力した値がy列にあるので処理を抜ける はC列の間違いです。。。 C列がリストが反映する列になってまして、Y列のリストからの選択及び新規入力の列になります。。。度々、申し訳ないのですがこの場合は MyC = Application.Match(Cells(a + MyCount - 1, 1).Value の「１」を「３」に直せばいいのでしょうか？ （miu）
(*'ω'*)......ん? ってことは・・・、 A列の変化と、C列の変化に合わせて別の処理ってことになりますね。
それでは、当初の入力規則の削除及び設定のコードと、今朝の入力規則の追加のコードを Target.Colmunによって分岐させたら良いような気がします。 （川野鮎太郎）
川野鮎太郎さん、 大変申し訳ないのですが、詳しく教えて頂いてもよろしいでしょうか？ Target.Colmunで、A列、C列を分岐させるということだとお思うのですが、 プログラムの作成の仕方が、まだよくわかってないので、何卒宜しくお願い致します。
追記 ちょっとだけ試しに、やってみたのですがうまく動作しませんでした・・・・。 やっぱりお願いします。 入力規則と結合の動作が終わった所に、下記を入れてみました・・・。 何も変わらないかったです。。。
'入力規則のリスト追加(C列が選択欄、ｙ列がリスト範囲欄）
If Target.Column <> 3 Then Exit Sub '変化したセルがc列目以外は処理を抜ける
If Target.Count <> 1 Then Exit Sub '変化したセルが複数の場合は処理を抜ける
MyRow = Range("y1").End(xlDown).Row 'y1の最下行の行番号をMyRowに代入
Set MyRange = Range("y1").Resize(MyRow, 1) 'y1セルをMyRow行だけ範囲を広げたものをMyRangeに代入
On Error GoTo ErrorHandler 'エラーが出たら、ErrorHandler:（エラー処理ルーチン）から処理を始める
MyC = Application.Match(Target.Value, MyRange, 0) 'VBAでワークシート関数を使うために、Matchの前にApplication.を付ける。
Exit Sub 'Match関数でエラーが出ないってことは、c列に入力した値がy列にあるので処理を抜ける
ErrorHandler: '上で書いたようにMatch関数でエラーが出るってことは、A列に入力した値がB列に無いので以下の処理を行う
Cells(MyRow + 1, 25).Value = Target.Value 'y列の最終行の1行下に入力した値を入れる
（miu）
今後の勉強のためにもヒントだけ。 これで少し頑張ってみてください。＾＾ｖ
If Target.Column =1 Then '入力規則の削除及び設定の処理 Else '入力規則の追加処理 End If
（川野鮎太郎）
できました！！！ わかりやすいヒントありがとうございます。<m(__)m> とりあえず、今回のプログラムを復習しながら理解してみます。 本当にありがとうございました。 （miu)
コメント返信：
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.