質問: 【excel】 数階層のドロップダウンリストを設定 excel2007を使っています。 b3を分類の「a、b、c」のドロップダウンリストから選択します。 ※別表のg3:g16を元にしますが、「a、a、a、a、a、a、b、b、b・・・」とならないようにしたいです。 また、b3に「a」を選んだ場合、c3に「ddd、eee、fff」のドロップダウンが表示され、 c3に「ddd」を選んだ場合、d3に「1001、1002」のドロップダウンが表示され、 いずれかを選択します。 このような入力規制を設定したいのですが、 b3、c3、d3をどのように設定したらよいのか教えて下さい。 宜しくお願いいたします。
回答: こんにちは。#1、2、4、6、cjです。 #6で触れていた > ...セル範囲の参照を容易に変更できる内容に書き換え... やってみました。 その影響で処理の効率が落ちる面もあるので、その分、 他の部分を見直して補い、トータルでは、前より動作が軽くなっています。 先頭の2カ所だけ、セル範囲を指定すれば、 テーブルの位置を変更した場合にも容易に対応できます。 動作仕様はこれまで提示したものとまったく同じです。 まるまる差し替えで使ってください。 それでは、また。 ' ' ============================== option explicit ' ' ------------------------------ const イベント範囲 as string = "c9:d20" ' 下位の入力規則を変更するイベント処理対象範囲の参照(2列)■要指定 const マスタ左上 as string = "v9" ' マスタテーブル範囲の参照(データ部左上の単セル)■要指定 ' ' ユーザー設定 ↑ ' ' ------------------------------ ' ' 固定 ↓ const shoge as string = "分類" const scomma as string = "," ' ' 参照設定する場合◆ : microsoft scripting runtime private odict(0 to 2) as object ' as scripting.dictionary ' ◆ ' ' ------------------------------ sub 初期設定() call setvalid end sub ' ' ------------------------------ private sub setvalid(optional byval target as range) dim skey as string dim slist as string dim nfldpos as long dim noffset as long dim i as long if target is nothing then set target = range(イベント範囲) skey = shoge ' "分類" ' nfldpos = 0& : noffset = 0& else skey = target.value nfldpos = target.column - range(イベント範囲).column + 1 noffset = 1& end if application.enableevents = false on error goto exit_ if odict(0) is nothing then call setdict with target for i = nfldpos to 2 noffset = noffset + 1& slist = odict(i)(skey) ' ",a,b,c" ",ddd,eee,fff" ",1001,1002" with .columns(noffset) with .validation .delete .add type:=xlvalidatelist, alertstyle:=xlvalidalertstop, formula1:=slist ' .ignoreblank = true ' .incelldropdown = true end with skey = split(slist, scomma)(1) ' "a" "ddd" "1001" .value = skey end with next i end with exit_: application.enableevents = true if err then msgbox err & err.description, vbexclamation end sub ' ' ------------------------------ private sub setdict() dim mtxt() dim i as long with range(マスタ左上) mtxt = .resize(.end(xldown).row - .row + 1, 3).value end with for i = 0 to 2 set odict(i) = createobject("scripting.dictionary") ' set odict(i) = new scripting.dictionary ' ◆ next i for i = 1 to ubound(mtxt) if not odict(1).exists(mtxt(i, 1)) then odict(0)(shoge) = odict(0)(shoge) & scomma & mtxt(i, 1) odict(1)(mtxt(i, 1)) = odict(1)(mtxt(i, 1)) & scomma & mtxt(i, 2) elseif not odict(2).exists(mtxt(i, 2)) then odict(1)(mtxt(i, 1)) = odict(1)(mtxt(i, 1)) & scomma & mtxt(i, 2) end if odict(2)(mtxt(i, 2)) = odict(2)(mtxt(i, 2)) & scomma & mtxt(i, 3) next i erase mtxt() '' ' < ツリー確認用 ' dim k1, k2, s2, v0, v1 ' debug.print shoge, odict(0)(shoge) ' k1 = odict(1).keys 'split(shoge, scomma) ' for each v0 in k1 ' debug.print , v0, odict(1)(v0) ' k2 = split(odict(1)(v0), scomma) ' for each v1 in k2 ' debug.print , , v1, odict(2)(v1) ' next ' next '' ' > end sub ' ' ------------------------------ private sub worksheet_change(byval target as range) if target.count > 1 then exit sub if target.value = "" then exit sub if intersect(range(イベント範囲).resize(, 2), target) is nothing then exit sub call setvalid(target) end sub ' ' ------------------------------ private sub worksheet_deactivate() erase odict() end sub ' ' ==============================