エクセルで発注書を作成しておりますが、商品名の入力での入力間違いを
防ぐ為、入力規制(リスト)を使用しようかと思っております。
しかしながら、商品台帳は別シート上で下記の通り定型フォームと
なっており、発注書上の「大分類」「中分類」「小分類」入力箇所にて
リスト形式で商品を絞っていく体裁にしたいと思っております。
大分類中分類小分類
家電パソコンPC-JD777
家電パソコンPC-JD999
家電テレビTV-32T
家電テレビTV-45J
家電DVDプレーヤー590DV
家電DVDプレーヤー620DV
日常雑貨文房具鉛筆
日常雑貨文房具消しゴム
日常雑貨文房具シャープペン
日常雑貨台所用品なべ
日常雑貨台所用品やかん
食品野菜にんじん
食品野菜キャベツ
食品肉類牛肉
食品肉類豚肉
エクセルの入力規制(リスト)での作成をいろいろ調べたのですが、
どうもよく分かりません。
マクロ・VBAでも構いませんので何卒宜しくお願いいたします。
A 回答 (5件)
- 最新から表示
- 回答順に表示
No.1
- 回答日時:
この回答への補足
回答ありがとうございました。
しかしながら、例えば「大分類」でリスト化した場合、
家電
家電
家電
家電
日常雑貨
日常雑貨
日常雑貨
と同一名称が重複して表示されてしまいます。
これをオートフィルかけた際のように同一名称をまとめて表示できない
ものでしょうか?
また名前の定義ですが、元データとなる商品リストは随時新商品が追加
となっていく事、元データはcsvデータであることから「名前の定義」は
難しい状況です。
良い知恵をどうかお貸しください。
No.2
- 回答日時:
> 元データとなる商品リストは随時新商品が追加となっていく事、
> 元データはcsvデータであることから
そうなるとやはり、VBA組むしかないですね。
ただ、リストの直接のもととなるデータ(大分類、中分類)は、
CSVから入ってきたシートでなく、別に用意したシートから持ってくるようにしておき、
そのシートに名前付けをしておき、CSVをと入り込む都度、リストデータを
作り出すようなVBAを組むことでしょうね。
Accessだともっと楽なんですけど...
また、有償ですが、
http://www.civil-design.net/soft_ippan/kaisoulis …
上記のようなものをみつけましたが、質問者さんの運用環境に合っているかどうか....
No.3
- 回答日時:
Accessだと沢山ヒットしますが、Excelは見つかりませんね。
興味本位で作ってみました。セルの絶対指定を多用した融通の利かない、動けば良いというレベルのコードですが、何かの参考になれば幸いです。当方Excel2000です。複雑なので、環境が違って動かないケースのアドバイスはしかねます。綴りの間違いはご笑納下さい。「DB」及び「入力」という名称のシートを用います。DBシートにデータを追加しても、そのままで動く仕様にしてあります。
"DB"シート フィルターオプションで絞り込みます
..............A..............B..............C
1..........大分類.......中分類.......小分類
2..........(自動で設定)
3~5行は空
6..........大分類.......中分類.......小分類
7..........家電........パソコン......PC-JD777
8..........家電........パソコン......PC-JD999
9..........家電........テレビ.......TV-32T
10..........家電........テレビ.......TV-45J
11..........家電........DVDプレーヤー..590DV
12..........家電........DVDプレーヤー..620DV
13..........日常雑貨......文房具.......鉛筆
14..........日常雑貨......文房具.......消しゴム
後略
"入力"シート A2→B2→C2の順に自動で入力規則を設定し、その中から選択できます(但しA2はファイルオープン時に設定)
..............A..............B..............C
1..........大分類.......中分類.......小分類
2.........(自動で入力規則-リストが設定される)
<標準モジュール>
Public Enum classLevel
major = 0
middle = 1
minor = 2
End Enum
'ファイルオープン時に大分類を設定
Sub auto_open()
Call classification(major)
End Sub
'各入力規則を設定する
Sub classification(level As Long)
Dim dbSheet As Worksheet
Dim validationSheet As Worksheet
Dim targetRange As Range
Dim extractRange As Range
Set dbSheet = ThisWorkbook.Sheets("DB")
Set validationSheet = ThisWorkbook.Sheets("入力")
If dbSheet.FilterMode = True Then dbSheet.ShowAllData
Select Case level
Case major
dbSheet.Range("$A$2:$B$2").Clear
Set targetRange = Intersect(dbSheet.Range("A6").CurrentRegion, dbSheet.Columns(1))
targetRange.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set extractRange = targetRange.SpecialCells(xlCellTypeVisible)
validationSheet.Range("A2:C2").Clear
Call setValidation(validationSheet.Range("A2"), validationString(extractRange))
Case middle
dbSheet.Range("A2").Value = validationSheet.Range("A2")
Set targetRange = Intersect(dbSheet.Range("A6").CurrentRegion, dbSheet.Columns("$A:$B"))
targetRange.AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=dbSheet.Range("A1:A2"), Unique:=True
Set extractRange = Intersect(targetRange.SpecialCells(xlCellTypeVisible), targetRange.Columns(2))
validationSheet.Range("B2:C2").Clear
Call setValidation(validationSheet.Range("B2"), validationString(extractRange))
Case minor
dbSheet.Range("B2").Value = validationSheet.Range("B2")
Set targetRange = dbSheet.Range("A6").CurrentRegion
targetRange.AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=dbSheet.Range("A1:B2"), Unique:=True
Set extractRange = Intersect(targetRange.SpecialCells(xlCellTypeVisible), targetRange.Columns(3))
validationSheet.Range("C2").Clear
Call setValidation(validationSheet.Range("C2"), validationString(extractRange))
End Select
End Sub
Private Function validationString(extractRange As Range)
Dim targetArea As Range
Dim i As Long
Dim fieldName As String
fieldName = extractRange.Cells(1).Value
For Each targetArea In extractRange.Areas
For i = 1 To targetArea.Rows.Count
If targetArea.Cells(i).Value <> fieldName Then
If validationString = "" Then
validationString = targetArea.Cells(i).Value
Else
validationString = validationString & "," & targetArea.Cells(i).Value
End If
End If
Next i
Next targetArea
End Function
Sub setValidation(targetRange As Range, validationString As String)
With targetRange.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=validationString
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.IMEMode = xlIMEModeNoControl
.ShowInput = True
.ShowError = True
End With
End Sub
<入力シートモジュール>
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("$a$2:$b$2")) Is Nothing Then Exit Sub
Select Case Target.Address
Case "$A$2"
Call classification(middle)
Case "$B$2"
Call classification(minor)
End Select
End Sub
この回答への補足
ご回答大変ありがとうございました!
親身に対応いただき大変感激しております。
VBAは最近始めたばかり、まだ手探り状態ですが参考にさせていただき、
勉強していきたいと思います。
ご回答いただいた構文をDBシート、入力シートのモジュールに貼り付け、
マクロを動かしてみたのですが、入力モジュールの5行目
「Call classification」が反転され、コンパイルエラー(Subまたは
functionが定義されてません」と表示されます。そこでOKを押すと、
1行目の「Private Sub Worksheet_Change(ByVal Target As Range)」
が黄色に色づき、エラーとなります。
何分本当にまだ良く分からなくて、せっかくご教授いただいたのに、
うまく利用できません。
大変恐れ入りますが解決策や見当違いなことをやっているのであれば、
ご指摘いただけないでしょうか?どうぞ宜しくお願いいたします。
No.4
- 回答日時:
ANo3です。
>構文をDBシート、入力シートのモジュールに貼り付け、
>マクロを動かしてみたのですが、入力モジュールの5行目...
とありますが、長い方のコードをもし、DBシートモジュールに貼り付けているなら、標準モジュールに貼り付けて下さい。
DBシートにはコードは記述しません。
※VBEで挿入/標準モジュールを実行すると、Module1が生成されますので、そこに貼り付けて下さい。シートモジュールをご存じの方なら、お分かりだとは思いますが念のため。
No.5
- 回答日時:
ANo3です。
補足ですが、大分類はブックを開いた時に設定する様になっておりますので、実行前にファイルを一旦閉じて開き直すか、VBEでSub Auto_Openを実行して下さい。
コードをすっきりさせようとトライしましたので、ご参考に添付します。
<標準モジュール>
Public Enum classLevel
major = 0
middle = 1
minor = 2
End Enum
'ファイルオープン時に大分類を設定
Sub auto_open()
Call classification(classLevel.major)
End Sub
'各入力規則を設定する
Sub classification(level As Long)
Dim dbSheet As Worksheet
Dim validationSheet As Worksheet
Dim extractRange As Range
Dim criteriaArea As Range
Dim dataTable As Range
Dim inputArea As Range
Set dbSheet = ThisWorkbook.Sheets("DB")
Set validationSheet = ThisWorkbook.Sheets("入力")
Set dataTable = dbSheet.Range("$A$6").CurrentRegion
Set criteriaArea = dbSheet.Range("$A$1:$B$2")
Set inputArea = validationSheet.Range("$A$1:$C$2")
If dbSheet.FilterMode = True Then dbSheet.ShowAllData
Select Case level
Case classLevel.major
criteriaArea.Rows(2).Clear 'これを入れないとフィルターが誤動作
With dataTable.Columns(1)
.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set extractRange = .SpecialCells(xlCellTypeVisible)
End With
inputArea.Rows(2).Clear
Call setValidation(inputArea.Cells(2, 1), validationString(extractRange))
Case classLevel.middle
criteriaArea.Cells(2, 1).Value = inputArea.Cells(2, 1)
With dataTable.Columns("A:B")
.AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=criteriaArea.Columns(1), Unique:=True
Set extractRange = Intersect(.SpecialCells(xlCellTypeVisible), .Columns(2))
End With
inputArea.Range(Cells(2, 2), Cells(2, 3)).Clear
Call setValidation(inputArea.Cells(2, 2), validationString(extractRange))
Case classLevel.minor
criteriaArea.Cells(2, 2).Value = inputArea.Cells(2, 2)
With dataTable
.AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=criteriaArea, Unique:=True
Set extractRange = Intersect(.SpecialCells(xlCellTypeVisible), .Columns(3))
End With
inputArea.Cells(2, 3).Clear
Call setValidation(inputArea.Cells(2, 3), validationString(extractRange))
End Select
End Sub
'非連続の範囲の値を、カンマ区切り文字列に統合する(先頭=フィールド名として除外する)
Private Function validationString(extractRange As Range)
Dim targetArea As Range
Dim i As Long
Dim fieldName As String
fieldName = extractRange.Cells(1).Value
For Each targetArea In extractRange.Areas
For i = 1 To targetArea.Rows.Count
If targetArea.Cells(i).Value <> fieldName Then
If validationString = "" Then
validationString = targetArea.Cells(i).Value
Else
validationString = validationString & "," & targetArea.Cells(i).Value
End If
End If
Next i
Next targetArea
End Function
'入力規則-リスト文字列・ドロップダウンを設定する
Sub setValidation(targetRange As Range, validationString As String)
With targetRange.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=validationString
End With
End Sub
<入力シートモジュール>
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("$a$2:$b$2")) Is Nothing Then Exit Sub
Select Case Target.Address
Case "$A$2"
Call classification(classLevel.middle)
Case "$B$2"
Call classification(classLevel.minor)
End Select
End Sub
この回答への補足
敏速なご返答大変ありがとうございます!
ご指摘いただいた通り、とんちんかんな事をしておりまして、標準モジュール
に組み込みましたら、無事動きました!
本当にありがとうございました。
いただいたコードはまだ全て理解できてませんが、今回の例題として
コツコツと解析し勉強させていただきます。その過程で、今回のVBAの
疑問点や不明点がありましたら、また補足質問させていただくかと
思いますが、気が向いた際で構いませんので宜しくお願いいたします。
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルで80万行、50列位のデ...
-
ゼロを表示
-
Excelの計算が合いません。 諸...
-
Excelの警告について
-
今まで文字化けなく開けていたc...
-
EXCELの散布図で日付が1900年に...
-
エクセルでファイルの最終更新...
-
エクセルの数式バーのフォント...
-
作成した数式を値として表示し...
-
ExcelでASCを使って全角を半角...
-
Excelセルを跨いで合計を出す方法
-
Excel 大小比較演算子による「...
-
Excel関数について教えてくださ...
-
マクロの処理が遅くなった
-
エクセルで入力すると隣のセル...
-
Excel関数について教えてくださ...
-
エクセルの文字が途中から消える
-
エクセルを使用して、円周率を...
-
エクセルのセル内に分数などの...
-
条件付き書式設定で罫線を引き...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
Excelの警告について
-
Excelで数値を時間数に変換する...
-
エクセルの数式バーのフォント...
-
エクセルで数字の組み合わせを...
-
エクセルを使用して、円周率を...
-
Excelで特定の文字列が含まれて...
-
Excel 対象のセルに入力が無い...
-
任意の値が存在する行に名前を...
-
エクセルでファイルの最終更新...
-
index関数の説明をお願いします。
-
条件付き書式でやりたいのですが
-
重複しない値を取り出したい
-
【ExcelVBA】UTF-8(BOM無)でC...
-
【マクロ】マクロが割当てされ...
-
エクセル IF計算式?でしょうか?
-
エクセルで曜日を入れたい
-
表中の指定した条件の文字列を...
-
【Excel】版が同じ事を示す番号...
-
EXCELの散布図で日付が1900年に...
-
Excelについて。Excelに縦1列に...
おすすめ情報