エクセルの学校：全文検索：Hyper Estraier： IF

Results of 1 - 1 of about 37678 for IF (0.007 sec.)

[[20160805223155]]: #score: 1591; @digest: 3adb5c80eb0a4d422551141e3e8cfbd2; @id: 71307; @mdate: 2016-08-10T13:21:27Z; @size: 59863; @type: text/plain; #keywords: modflag (297727), numcol (197733), errcheck (173562), wpos0 (154997), lstcol (113684), makelist (84404), beforeupdate (74624), shm (48425), returnboolean (42378), listbox1 (39395), 当名 (35052), combobox2 (31980), combobox1 (29783), listindex (28632), msforms (28349), 引先 (22233), 担当 (20945), 取引 (18968), cancel (16986), 元シ (16175), rowsource (15373), private (14453), ンボ (13672), ボボ (13571), ーフ (8898), シジ (8405), textbox1 (7844), ォー (7321), currentregion (6839), ーム (6472), 2016 (6151), フォ (5744); 『ユーザーフォームについて』（ゆう）
いつも拝見させて頂き、勉強させてもらってます! 上司に無茶ぶりを受け、困ってます(>_<) ぜひ皆様のお知恵を拝借させて下さい!! 会社資料（予算&売り上げの表）を作ってるのですが、上司がエクセルの表に直接入力を嫌がっており、ユーザーフォームによる入力を希望しています。資料は入力用シートに予算などの額を担当・取引先ごとに一覧にしてます A列 B列 C列 D列担当名取引先名 4月 5月・・・田中 P社 150000 200000 阿部 N社 100000 120000 担当名から担当毎の取引先をコンボボックスで選択するところまでは出来たのですが、その後、その取引先があれば、4月〜翌年5月までつまりC〜N列（行は変数で取得?）の入力された予算額が出力されるようにし、ユーザーフォーム上で変更すれば、実際のセルも置き換わるようにできますでしょうか?? また、コンボボックスでない場合は新規で登録（担当名、取引先、4月〜翌5月まで）し、入力シートに入力ある行の次の行に追加出来ないでしょうか?? ユーザーフォームの作成は初めてですので、簡単に注釈を頂けると助かります。お時間かかっても構いませんので、どなたか教えて下さい(>_<) ＜使用 Excel:Excel2013、使用 OS:Windows7 ＞ ---- イメージがあうのでしょうか、シート上のリストのメンテナンスをユーザーフォームで行いたいというリクエストはよくあがってきますね。コード自体は、そんなに難しいものではなく、標準的なものを積み重ねて作成可能ですけど、難しいのは操作のシナリオというか、人間が入力する、その際の、新規、変更、追加、削除、さらには挿入といったものの操作をどのようなコントロールで、どのような指示によって、どのように実現するのか、そのデザインです。デザイン自体は、コードとは関係のない部分ですから、ここをしっかりと整理して、その仕様を提示できますか? というか、そのシナリオを、しっかりと（利用する人が使いやすいように）描き切ることが重要です。別のポイントで考えますと、エクセルのシートは、実に柔軟で強力な入力ツールです。挿入であれ、削除であれ、ワンクリック、ツークリックでできてしまいますし、フィルコピーやどさっとコピペなんてのも可能ですよね。必要なら並び替えや置換、さらには元に戻すといった、エクセルの強力な機能を、そのまま使うこともできます。このエクセルシートが持つ機能と同等のものをユーザーフォームで実現するのは、ほぼ至難の技で、どうしても窮屈な、限定された機能の提供しかできないということも、しっかりと考慮必要です。いいかえると、エクセルシートは、きわめて高度で、大きなユーザーフォームそのものだと考えることもできます。直接、シートに触るのがいやだということなら、別シートで、入力支援のレイアウトをデザインしておいて、そこでの入力を元シートに反映させることもできますよね。そのあたりも、検討してみてください。また、ユーザーフォームで実現するとしても、そのための必要な機能等を含めたシナリオ作成が重要だと申し上げましたがそのシナリオ作成のヒントを得るために、エクセルに標準で備わっている、データフォームを使って、まずは運用してみる。で、それで満足なら最高ですし、それに、ちょこっと、こういう機能を追加したいといったものが（実際の要望として）でてきたところで、そういったものをまとめて、ゆうさん独自のシナリオとして整理して、必要なら、そのシナリオ（仕様）を提示して、コード作成の支援をリクエストされたらいいのでは? と思ったりします。追記）4月〜翌5月は 4月〜翌3月ですね。（β） 2016/08/06(土) 08:05 ---- βさまアドバイスありがとうございます☆彡ちょっと一旦,ユーザーフォームから離れて, シートでの処理をベースに考えてみようかと思います。そこで,またお知恵を貸してください（＞_＜）並びは, A列 B列 C列 D列担当名取引先名 4月 5月・・・田中 P社 150000 200000 阿部 N社 100000 120000 の並びです。そしてO列に担当の所属するグループ名, P列に取引先が新規の場合は新規と入力するセルになってます。上司の要望として, ・入力シートの取引先が合計150件ほどあるので, 1つの取引先のC列〜N列の予算額を変更する際,検索するのが大変・入力シートに取引先を新たに足す場合,簡単に入力したいというのがあり,ユーザーフォームのように,入力箇所が判りやすいものがほしいとの事です。で,一旦ユーザーフォーム以外で考えたいのですが, 例えば, ?@上司用の簡易入力シートを作り, 各担当者名のコンボボックスと,それに連動した取引先が出るコンボボックスの2点をシート上に作成（これはおそらく自分で作成できます） ?A↑で選択して出た取引先名と,入力シートのA列で一致する名前があるかを探し, あればシート上に出し,その名前と同じ行のC‾N列の予算額を抽出 ?B↑で抽出した額を変更すれば,入力用シートでも変更される ?C・・・?Aで一致した名前が無い場合,入力用シートのA列の最終行を取得し, その最終行に,簡易入力シートで入力した取引先名,担当者名,最終行のC‾N列に簡易入力シートで作成した額が反映されるというような仕様を考えてます。長々と説明してごめんなさい。こんな仕様を考えてますが,いかがでしょうか? ※もし上記の他に何か方法があるようでしたら,ご意見きかせてほしいです（＞_＜）（ゆう） 2016/08/06(土) 15:07 ---- 入力支援用シートの前に、もっと手っ取り早く、データフォームを提案しましたが、もう1つ、テーブルを使うのはいかがですか。テーブルもエクセルのセル領域ですから行の挿入、削除も自由ですし、追加したものも自動的に各セルの書式継承はもちろんのこと自動的にテーブルのメンバーとして認識してくれます。もちろん、コピペも自由です。テーブルのデザインも、いろいろ選ぶこともできるので視覚的にも、立派な帳票になります。何より、先頭のタイトル行にオートフィルターの▼がつきますので、そこで担当でも取引先でも自由に絞り込み可能です。つまり、コンボボックスで実行しようとしていたことが、なにもしなくても実現できるわけです。是非、検討してみてください。（β） 2016/08/06(土) 16:31 ---- β様テーブルにした場合、中に入ってる関数とかは、データに置き換わるんでしたっけ?? あまり入力用シートを直接触りたくない&視覚的にどこに入力するかすぐ分かるようなものが欲しいようで、ユーザフォームみたいなのが欲しいと、最初言われていました。なので、テーブルに変えるのはあまり解決にならないかもです。折角提案してくださったのにすみません。最初はユーザフォームとして、担当名(コンボボックス1)、取引先名(コンボボックス2)を上の方に配置し、その下に4月という文字、その横に予算欄(抽出した金額がでる) その2つの下に5月と、その月の予算、さらに下は6月、、、そして翌年3月の下にチェックボックスを配置[新規登録の場合はチェックすると入力用のP列に新規と出力される) そして最後に登録変更ボタン、新規登録ボタン、を追加しようと考えていました。最初におっしゃっていたデータフォームというのは、こういうユーザフォームのデザインということでしょうか?? （ゆう） 2016/08/06(土) 17:15 ---- ＞こういうユーザフォームのデザインということでしょうか?? http://www4.synapse.ne.jp/yone/excel2010/excel2010_ribbon_form.html （マナ） 2016/08/06(土) 21:16 ---- まず、私は決してユーザーフォームによる対応を否定はしていません。むしろ、いずれ、是非、チャレンジして、良いものを作っていただきたいと、そう思っています。ただ、特に上司は、ユーザーフォームなら、シートでのメンテより、もっとかっこよく、かつ多機能な操作ができるだろうとそう思いがちで、実際にやってみると、おいおい、エクセルではこんなこと、あたりまえにできるよ。なぜユーザーフォームでできないの? なんていわれ、無理やり、コードを変更追加。で、しばらくすると、また、こんな操作ってできないの? で、また無理やりコードを変更追加。・・・・・この繰り返しの結果、もう、コードがしっちゃかめっちゃかで、何がなんだかわからない代物になってしまう。ありがちなんです。この状況は。なので、最終解決方法ということではなく、テーブルやデータフォームを使いながら【ユーザーフォームでやるなら、こんな機能がほしいね。こんな操作手順にしようね。】こんなシナリオ作りの期間にしてはいかがですかと提案したんです。【エクセルデータフォーム】で検索すると、解説ページがたくさん出てきます。是非、一度、試行してみてください。繰り返します。これで解決しようということではなくどんなものを作るか、そのデザインやシナリオを確定させるための準備期間です。まぁ、それではご不満でしょうから、ユーザーフォームで処理するサンプルを、書いてみます。しばし時間ください。（β） 2016/08/06(土) 22:41 ---- マナ様まさに、こういうフォームを求めていました! こんな機能があったのですね!! ただ、例えば新規登録の場合は事前に空白行を入れておかないと新たに行の追加が出来ないのですが、最終行に追加する、という方法をとる場合、 VBAでの処理になりますか????(ﾟДﾟ) また、金額をいれてるのですが、シートでは桁区切りなのですが、桁区切りなしで表示されるのですが、そういう細かい設定は、フォームでは難しいでしょうか? （ゆう） 2016/08/06(土) 23:08 ---- β様すみません、コメントが衝突してたようで、いまコメントを拝見致しました! そういう懸念の元でのアドバイスだったんですね! 確かに、おっしゃっている通りになりそうな気がします。やはり、もっと必要な仕様について話した上で、試行錯誤を繰り返して必要、不必要などを詰めた方が良さそうですね。上司に見せる用のひとまずのサンプルは必要になるので、私も再度検索してみます!! サンプルを書いて頂けるとの事ですが、あまり無理はなさらないで下さいね! 私もこれから勉強していきます! （ゆう） 2016/08/06(土) 23:18 ---- ちょっと書いてみました。なお、チェックボックスによる新規マークのセットは行っていません。どんどん追加（あるいは挿入追加）をしていくと新規だらけになってしまう。それに、どんな意味があるのかな?と。（新規マークのセット自体は簡単ですけど）・元シート、現在は P列まであるんだと思いますが、その最終列記号をコードの先頭のほうで規定しています。（●印）将来列が増えればここを直してください。・シートへの更新時に使う行番号格納のため、最後の列の次の列（現在はQ列）を作業列に使います。見苦しいので（?）非表示列にしておいてください。・コンボボックスでデータを絞り込むための作業シートを使います。見ぐるしいので（?）これも非表示シートにしておいてください。・コードでは元シートを"Sheet1"、作業シートを"Sheet2"にしています。このは実際の名前にしてください。（★印）・コントロールは以下。 ComboBox1 担当者絞り込み用 ComboBox2 取引先絞り込み用 ListBox1 絞り込まれたデータ表示用横長にしておいてください。 TextBox1〜TextBox16 A列〜P列までの各項目用 CommandButton1 更新 CommandButton2 新規追加（シート末尾に追加します） CommandButton3 挿入追加（選ばれたデータの下に挿入します） CommandButton4 削除操作は、必要に応じてComboBox1,2で絞り込み（絞り込まなくてもいいですけど）標示されたListBox1のデータを選ぶとその内容が、TextBox1〜TextBox16に落とし込まれます。更新の場合、このTextBox1〜TextBox16を好きなように変更して、更新ボタン。新規追加の場合は、ListBox1から選ばず、直接 TextBox1〜TextBox16に入力してもOKですが、いずれにしても入力完了したら新規追加ボタン。挿入追加ちょっと操作手順を悩みましたが、他の処理コードと共通化するため、とりあえずListBoxからデータを選びます。あとは、TextBox1〜TextBox16を変更して、挿入追加ボタンを押すことで、選んだ行の下に挿入されます。削除はListBox1から選んだものがTextBox1〜TextBox16に落とし込まれますが、基本的には、何もせず、削除ボタン。もし、何かいじっていた場合、間違えて削除ボタンをおしたのかもしれないので、ワーニングメッセージを出して削除するかどうか確認します。なお、ListBox1から選んだあと、選び直しはできるのですが、選んだものを変更した後、なんらかの処理ボタンをおさないまま、またListBox1から選ぶとワーニングを出して、項目を置き換えていいかどうかの確認をします。凝れば、もっともっと、あれもこれもでしょうけど、基本形のサンプルとして。 Option Explicit Const lstCol As Long = 16 'リスト最終列列番号 "P" '● Dim numCol As Long Dim shM As Worksheet Dim shW As Worksheet Dim wPos0 As Range Dim wPos1 As Range Dim wPos2 As Range Dim modFlag As Boolean Private Sub UserForm_Initialize() Set shM = Sheets("Sheet1") '★ Set shW = Sheets("Sheet2") '★ numCol = lstCol + 1 '作業列番号 Set wPos0 = shW.Cells(1, numCol).Offset(, 2) '抽出用作業域 Set wPos1 = shW.Cells(1, numCol).Offset(, 5) 'ComboBox1用作業域 Set wPos2 = shW.Cells(1, numCol).Offset(, 7) 'COmboBox2用作業域 shW.Cells.Clear ListBox1.ColumnCount = lstCol ListBox1.ColumnHeads = True reset End Sub Private Sub ComboBox1_Change() If Me.Tag = "Skip" Then Exit Sub Me.Tag = "Skip" makeList Me.Tag = "" End Sub Private Sub ComboBox2_Change() If Me.Tag = "Skip" Then Exit Sub Me.Tag = "Skip" makeList Me.Tag = "" End Sub Private Sub ListBox1_Click() Dim x As Long Dim i As Long If Me.Tag = "Skip" Then Exit Sub If modFlag Then If MsgBox("変更済みの項目がありますが、選ばれたデータで書き換えますか?", vbYesNo) = vbNo Then Exit Sub End If i = ListBox1.List(ListBox1.ListIndex, numCol - 1) '選択行の元シート上の番号 For x = 1 To lstCol Me.Controls("TextBox" & x).Value = shM.Cells(i, x).Value Next modFlag = False End Sub Private Sub CommandButton1_Click() '更新 Dim i As Long If ListBox1.ListIndex < 0 Then MsgBox "データが選択されていません" Exit Sub End If i = ListBox1.List(ListBox1.ListIndex, numCol - 1) '選択行の元シート上の番号 Text2Sheet i reset End Sub Private Sub CommandButton2_Click() '新規追加 Text2Sheet shM.Range("A" & Rows.Count).End(xlUp).Offset(1).Row reset End Sub Private Sub CommandButton3_Click() '挿入 Dim i As Long If ListBox1.ListIndex < 0 Then MsgBox "データが選択されていません" Exit Sub End If i = ListBox1.List(ListBox1.ListIndex, numCol - 1) '選択行の元シート上の番号 shM.Rows(i + 1).Insert Text2Sheet i + 1 reset End Sub Private Sub CommandButton4_Click() '削除 Dim i As Long If ListBox1.ListIndex < 0 Then MsgBox "データが選択されていません" Exit Sub End If If modFlag Then If MsgBox("変更済みの項目がありますが、無視して選ばれたデータを削除しますか?", vbYesNo) = vbNo Then Exit Sub End If i = ListBox1.List(ListBox1.ListIndex, numCol - 1) '選択行の元シート上の番号 shM.Rows(i).Delete reset End Sub Private Sub reset() Dim sv1 As String Dim sv2 As String Me.Tag = "SKip" clearText sv1 = ComboBox1.Value sv2 = ComboBox2.Value set連番 setコンボ ComboBox1.Value = sv1 ComboBox2.Value = sv2 makeList Me.Tag = "" End Sub Private Sub set連番() With shM.Range("A1").CurrentRegion .Cells(1, numCol).Value = 1 .Cells(1, numCol).Resize(.Rows.Count).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False End With End Sub Private Sub setコンボ() ComboBox1.Clear ComboBox2.Clear wPos1.CurrentRegion.ClearContents shM.Columns("A").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wPos1, Unique:=True wPos2.CurrentRegion.ClearContents shM.Columns("B").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=wPos2, Unique:=True With wPos1.CurrentRegion ComboBox1.List = .Offset(1).Resize(.Rows.Count - 1).Value End With With wPos2.CurrentRegion ComboBox2.List = .Offset(1).Resize(.Rows.Count - 1).Value End With End Sub Private Sub makeList() clearText ListBox1.RowSource = "" shW.Range("A1").CurrentRegion.ClearContents wPos0.Resize(, 2).Value = shM.Range("A1:B1").Value wPos0.Offset(1).Resize(, 2).Value = Array(ComboBox1.Value, ComboBox2.Value) shM.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=wPos0.Resize(2, 2), CopyToRange:=shW.Range("A1"), Unique:=False With shW.Range("A1").CurrentRegion If .Rows.Count > 1 Then ListBox1.RowSource = .Offset(1).Resize(.Rows.Count - 1).Address(External:=True) Me.Tag = "" If .Rows.Count = 2 Then ListBox1.ListIndex = 0 End With End Sub Private Sub clearText() Dim x As Long For x = 1 To lstCol Me.Controls("TextBox" & x).Value = "" Next modFlag = False End Sub Private Sub Text2Sheet(n As Long) Dim x As Long For x = 1 To lstCol shM.Cells(n, x).Value = Me.Controls("TextBox" & x).Value Next End Sub Private Sub TextBox1_Change() modFlag = True End Sub Private Sub TextBox2_Change() modFlag = True End Sub Private Sub TextBox3_Change() modFlag = True End Sub Private Sub TextBox4_Change() modFlag = True End Sub Private Sub TextBox5_Change() modFlag = True End Sub Private Sub TextBox6_Change() modFlag = True End Sub Private Sub TextBox7_Change() modFlag = True End Sub Private Sub TextBox8_Change() modFlag = True End Sub Private Sub TextBox9_Change() modFlag = True End Sub Private Sub TextBox10_Change() modFlag = True End Sub Private Sub TextBox11_Change() modFlag = True End Sub Private Sub TextBox12_Change() modFlag = True End Sub Private Sub TextBox13_Change() modFlag = True End Sub Private Sub TextBox14_Change() modFlag = True End Sub Private Sub TextBox15_Change() modFlag = True End Sub Private Sub TextBox16_Change() modFlag = True End Sub （β） 2016/08/06(土) 23:53 ---- いいわすれていたことがあります。 ComboBox1,2 で選択した結果のデータが1行だった場合、ListBox1にも1行表示されますが、その場合、選ばなくても TextBox1〜TextBox16に自動で落とし込みます。（β） 2016/08/07(日) 00:07 ---- β様かなり複雑なコードを、色々こちらの条件を考慮してもらった上で提示して頂きありがとうございます! ムネアツです。・゜・(ノД`)・゜・。早速順を追って試していきたいと思います! 今までより少しお時間頂くかもですが、またコメントさせて頂きますので、しばしお待ちくださいε=ε=ε=ε=ε=ε=┌(;￣◇￣)┘ （ゆう） 2016/08/07(日) 00:16 ---- ---- いったんエラー報告があったのでコメントを作製したんですが消されたようですね。とりあえず以下、用意したメモを貼り付けます。 >>オブジェクトが必要です”というエラーが出ました。えっえっ! チェックしてみます。ただ、危なっかしい変数保持ではあるのですがまず、このエラーにはならないと思っています。チェックしてみますが、エラーになる前に、どこかで、何かおかしなメッセージがでたなんてことはありませんでしたか? いずれにしても、ちょっと危なっかしいところなので、最終的には少し手を入れようと思っていたんですが。 >>実際の入力用シートのC列〜N列の予算額をSheet1、2に一旦抽出してるのでしょうか? >>もしそうだとしたら、4月だとか、各月の指定はどの箇所で処理されてますでしょうか?? まず、元シート(Sheet1)ですけど、レイアウトは、最初に定時されたもの A列が担当、B列が取引先、 C列が4月、D列が5月、・・・・O列がグループ、P列がステータス（?）といったものが 1行目がタイトル行、 2行目からデータ。こういうレイアウトを対象にしています。で、選択された各項目は、TextBox1〜TextBox16 に順番に納められます。 4月の予算額は TextBox3 に入ります。翌3月の予算額はTextBox14に入ります。当然、このままでは操作者が、どの箱が何月だということが見にくいですよね。なので、デザインとしては、通常は、配置レイアウトにより、これらTextBoxの横や上にLabelを置いてそのキャプションにタイトルをセットしておきます。これらのキャプションを、Sheet1のタイトル文字列から自動設定することは可能です。 TextBox1〜TextBox16 に対応するLabel1〜Label16を配置しておいてください。で、 Private Sub UserForm_Initialize() プロシジャに以下のように追加を行ってください。 Private Sub UserForm_Initialize() Dim x As Long '●追加してください Set shM = Sheets("Sheet1") '★ '記載省略 '記載省略 '記載省略 reset '●以下も追加してください For x = 1 To lstCol Me.Controls("Label" & x).Caption = shM.Cells(1, x).Value Next End Sub >>もしそうだとしたら、4月だとか、各月の指定はどの箇所で処理されてますでしょうか?? 特段、何月という指定は考えていません。必要なら、また、おいおいに。 ★ところで。 1）担当者に紐付く取引先というところを失念しています。今のところComboBox2には、すべての取引先が表示されます。とりあえずは、この形で試行してください。なるべく早く、改訂分をアップしますので。 2）今までのコード、TextBox1,TextBox2・・・や Label1,Label2・・・といった、配置した時に割り振られるデフォルトのオブジェクト名のままにして提示しています。今回のような要件で、ComboBoxやListBoxやCommandButtonは数も少ないですので、このままでもいいかと思いますが TextBoxやLabelの場合、今回は、入力シートとの紐付けがあります。（1なら A列、2ならB列）これは、今後、いろんな要件追加で、これら以外の TextBoxやLabelを追加していった場合、かつ、翌3月までではなく翌々3月までにしたいねなんてことで列を増やしたときに、TextBox16の後はTextBox17にしなければいけないんですがそのTextBox17というオブジェクトはすでに別のものとしてできてしまっていることになり、困ったことになります。なので、デザインで作ったコントロールの名前を初期設定値ではなく、独自のたとえば tbx_Item1,tbx_Item2 といったものにしておくのが望ましいです。ただ、今、それをやると混乱しそうですので、落ち着くまでは、このままで行きましょう。 ★しかし、いずれにしても【オブジェクトのエラー】、これを解決しなければ先に進みませんね。発生するはずが（基本的には）ないと思っているので、悩んでいます。（β） 2016/08/07(日) 08:21 ---- β様すみません、コメントがかぶってました! 前回のコメントから、エラーの原因に思い当たったので、一旦コメントを消して書き直しました・・・ややこしくしてごめんなさい! エラー原因は私の宣言の仕方です。・コンボボックスを作っています。今回β様に頂いたコードを貼った時に、＞Option Explicit ＞ Const lstCol As Long = 16 'リスト最終列列番号 "P" '● ＞Dim numCol As Long ＞Dim shM As Worksheet ＞Dim shW As Worksheet ＞Dim wPos0 As Range ＞Dim wPos1 As Range ＞Dim wPos2 As Range ＞Dim modFlag As Boolean この宣言部分が、コンボボックスの部分として認識されるようで、 ”End Subの後にはコメントしか入力出来ません”と出ます。フォームでのコードが初めてなので、この場合、コンボボックスのコードとどのように分けたらいいでしょう??? ちなみにコンボボックスは、 Private Sub UserForm_Initialize() Dim LastRow As Long LastRow = Sheets("担当").Cells(Rows.Count, "A").End(xlUp).Row ComboBox1.RowSource = "担当!A2:A" & LastRow End Sub Private Sub ComboBox1_Change() ComboBox2.Clear Worksheets("担当").Select myCol = ComboBox1.ListIndex + 12 For i = 2 To Cells(Rows.Count, myCol).End(xlUp).Row ComboBox2.AddItem Cells(i, myCol).Value Next End Sub です。 ---------------------------- すみません、今から出社なのでお返事遅くなるかもですが、追加で頂いたコードありがとうございます!! （ゆう） 2016/08/07(日) 08:37 ---- マクロモジュールの記述ルールは最初の部分 Sub や Function といったプロシジャ部分マクロモジュールには subプロシジャや Functionプロシジャといったものを 1つ、または複数記述するわけですが最初に登場するプロシジャの前の部分を【宣言部】と呼びます。この宣言部で規定した変数を、モジュールレベルの変数と呼び、このモジュールの、どのプロシジャからでも参照可能。一方、各プロシジャの中で規定した変数はプロシジャレベルの変数で、これは、このプロシジャの中でしか使えません。逆にいいますと、宣言部に書くべきものは宣言部以外に書くとエラーになります。ですから、 Option Explicit Const lstCol As Long = 16 'リスト最終列列番号 "P" '● Dim numCol As Long Dim shM As Worksheet Dim shW As Worksheet Dim wPos0 As Range Dim wPos1 As Range Dim wPos2 As Range Dim modFlag As Boolean これは、モジュールの一番上に貼り付けてください。変数のスコープ（適用範囲）はなるべく狭くしたほうがよく、モジュールレベルの変数は、扱いが難しいところもあるのですが今回、様々なプロシジャで使用する変数を、そのつど値を作成することなく使うため、モジュールレベルの変数として規定し Initializeルーティンで1回のみ、値をセットしています。（β） 2016/08/07(日) 09:59 ---- >>・コンボボックスを作っています。ちょっと気になっています。そうぞうするに、すでにユーザーフォームモジュールがあって、そこに提示された Private Sub UserForm_Initialize() プロシジャと Private Sub ComboBox1_Change() が書かれている。で、その下に私がアップしあものを貼り付けた? コード記述の場所もさることながら、私がアップしたコードの中にも、この2つのプリシジャが存在します。同じ名前のプロシジャを1つものジュールの中で複数書くことはできません。いったん、そちらで書いておられた、既存のコードを消して、私のコードだけにしてください。で、そちらのコードから "担当"シーとなるものを想像しながら、私がアップしたコードに組み入れることをこちらで考えておきます。（β） 2016/08/07(日) 11:24 ---- 担当シートのレイアウトを教えてください。コードから A1 にタイトル。A2以下のA列に担当者コードがあるのは想像できますが、コードの中の myCol = ComboBox1.ListIndex + 12 For i = 2 To Cells(Rows.Count, myCol).End(xlUp).Row ComboBox2.AddItem Cells(i, myCol).Value Next ComboBox1.ListIndex + 12 を筆頭に、このコードの意味がよくわかりません。取引先は、どこに、どんな形でセットされているのですか? （β） 2016/08/07(日) 13:00 ---- βさまそうです、自分で書いたコンボボックスのコードの下に、βさまのコードを貼って、ダブってるプロシジャの名前を少し変更しました! おうちに帰ったら、私のコードを消して試してみますね! ちょっと夜になっちゃうかもですが(´・Д・)」担当シートですが、コンボボックス1は担当名を選ぶもので、a1がタイトルでa2から下に担当名が並んでます。増減があるので、最終行を取得するかたちにしてます。コンボボックス2の担当名に呼応した取引先の一覧はL列以降に入力があります。 L1が担当名、L2以下はL1の取引先が下に並ぶようになってます。 M1は次の担当名で、M2以下にその担当の取引先が下に続くかたちです。こちらも担当が増えればL.M.N列…と続いたあとに増えるので、L以降の最終列は変動です本当に何から何までありがとうございます…>_<… （ゆう） 2016/08/07(日) 16:22 ---- 担当シートからのセット、および、数字の 9,999,999 編集対応を追加。また、担当名は表示のみで変更不可にしました。それと、項目名のための Label1〜Label16を追加しましたので、ユーザーフォームに追加してください。加えて、もし、データ入力結果、取引先が、選ばれた担当に登録されていなかった場合に担当シートの当該担当列に、追加。これについては、もし、不要なら、resetプロシジャ内の、 '====新規取引先なら、担当シートに追加 If ComboBox1.ListIndex >= 0 Then j = ComboBox1.ListIndex + 12 z = Application.Match(TextBox2.Value, shP.Range(shP.Cells(2, j), shP.Cells(Rows.Count, j).End(xlUp)), 0) If IsError(z) Then shP.Cells(Rows.Count, j).End(xlUp).Offset(1).Value = TextBox2.Value End If End If '===================================== これを消してください。現在のユーザーフォームのモジュールのコードをすべて削除し、以下を、そのままコピペで貼り付けてみてください。 Option Explicit Const lstCol As Long = 16 'リスト最終列列番号 "P" '● Dim numCol As Long Dim shM As Worksheet Dim shW As Worksheet Dim shP As Worksheet Dim wPos0 As Range Dim wPos1 As Range Dim wPos2 As Range Dim modFlag As Boolean Private Sub UserForm_Initialize() Dim x As Long Set shM = Sheets("Sheet1") '★ Set shW = Sheets("Sheet2") '★ Set shP = Sheets("担当") numCol = lstCol + 1 '作業列番号 Set wPos0 = shW.Cells(1, numCol).Offset(, 2) '抽出用作業域 Set wPos1 = shW.Cells(1, numCol).Offset(, 5) 'ComboBox1用作業域 Set wPos2 = shW.Cells(1, numCol).Offset(, 7) 'COmboBox2用作業域 shW.Cells.Clear ListBox1.ColumnCount = lstCol ListBox1.ColumnHeads = True With TextBox1 '担当者は表示項目 .TabStop = False .Locked = True End With With ComboBox1 .MatchRequired = True .List = shP.Range("A2", shP.Range("A" & Rows.Count).End(xlUp)).Value End With reset For x = 1 To lstCol Me.Controls("Label" & x).Caption = shM.Cells(1, x).Value Next End Sub Private Sub ComboBox1_Change() If Me.Tag = "Skip" Then Exit Sub Me.Tag = "Skip" ComboBox2.Clear setコンボ2 makeList Me.Tag = "" End Sub Private Sub ComboBox2_Change() If Me.Tag = "Skip" Then Exit Sub Me.Tag = "Skip" makeList Me.Tag = "" End Sub Private Sub ListBox1_Click() Dim x As Long Dim i As Long If Me.Tag = "Skip" Then Exit Sub If modFlag Then If MsgBox("変更済みの項目がありますが、選ばれたデータで書き換えますか?", vbYesNo) = vbNo Then Exit Sub End If i = ListBox1.List(ListBox1.ListIndex, numCol - 1) '選択行の元シート上の番号 For x = 1 To lstCol Me.Controls("TextBox" & x).Value = shM.Cells(i, x).Text Next modFlag = False End Sub Private Sub CommandButton1_Click() '更新 Dim i As Long If ListBox1.ListIndex < 0 Then MsgBox "データが選択されていません" Exit Sub End If i = ListBox1.List(ListBox1.ListIndex, numCol - 1) '選択行の元シート上の番号 Text2Sheet i reset End Sub Private Sub CommandButton2_Click() '新規追加 If ComboBox1.ListIndex < 0 Then MsgBox "担当が選ばれていません" Exit Sub End If Text2Sheet shM.Range("A" & Rows.Count).End(xlUp).Offset(1).Row reset End Sub Private Sub CommandButton3_Click() '挿入 Dim i As Long If ListBox1.ListIndex < 0 Then MsgBox "データが選択されていません" Exit Sub End If i = ListBox1.List(ListBox1.ListIndex, numCol - 1) '選択行の元シート上の番号 shM.Rows(i + 1).Insert Text2Sheet i + 1 reset End Sub Private Sub CommandButton4_Click() '削除 Dim i As Long If ListBox1.ListIndex < 0 Then MsgBox "データが選択されていません" Exit Sub End If If modFlag Then If MsgBox("変更済みの項目がありますが、無視して選ばれたデータを削除しますか?", vbYesNo) = vbNo Then Exit Sub End If i = ListBox1.List(ListBox1.ListIndex, numCol - 1) '選択行の元シート上の番号 shM.Rows(i).Delete reset End Sub Private Sub reset() Dim j As Long Dim z As Variant Dim sv2 As String Me.Tag = "SKip" '====新規取引先なら、担当シートに追加 If ComboBox1.ListIndex >= 0 Then j = ComboBox1.ListIndex + 12 z = Application.Match(TextBox2.Value, shP.Range(shP.Cells(2, j), shP.Cells(Rows.Count, j).End(xlUp)), 0) If IsError(z) Then shP.Cells(Rows.Count, j).End(xlUp).Offset(1).Value = TextBox2.Value End If End If '===================================== clearText sv2 = ComboBox2.Value set連番 setコンボ2 ComboBox2.Value = sv2 makeList Me.Tag = "" End Sub Private Sub set連番() With shM.Range("A1").CurrentRegion .Cells(1, numCol).Value = 1 .Cells(1, numCol).Resize(.Rows.Count).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False End With End Sub Private Sub setコンボ2() Dim j As Long ComboBox2.Clear If ComboBox1.Value <> "" Then j = ComboBox1.ListIndex + 12 ComboBox2.List = shP.Range(shP.Cells(2, j), shP.Cells(Rows.Count, j).End(xlUp)).Value End If End Sub Private Sub makeList() clearText ListBox1.RowSource = "" shW.Range("A1").CurrentRegion.ClearContents wPos0.Resize(, 2).Value = shM.Range("A1:B1").Value wPos0.Offset(1).Resize(, 2).Value = Array(ComboBox1.Value, ComboBox2.Value) shM.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=wPos0.Resize(2, 2), CopyToRange:=shW.Range("A1"), Unique:=False With shW.Range("A1").CurrentRegion If .Rows.Count > 1 Then ListBox1.RowSource = .Offset(1).Resize(.Rows.Count - 1).Address(External:=True) Me.Tag = "" If .Rows.Count = 2 Then ListBox1.ListIndex = 0 End With End Sub Private Sub clearText() Dim x As Long For x = 1 To lstCol Me.Controls("TextBox" & x).Value = "" Next modFlag = False End Sub Private Sub Text2Sheet(n As Long) Dim x As Long For x = 1 To lstCol shM.Cells(n, x).Value = Me.Controls("TextBox" & x).Value Next End Sub Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) modFlag = True End Sub Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) modFlag = True End Sub Private Sub TextBox3_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox3) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox4_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox4) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox5_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox5) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox6_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox6) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox7_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox7) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox8_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox8) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox9_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox9) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox10_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox10) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox11_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox11) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox12_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox12) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox13_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox13) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox14_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox14) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox15_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) modFlag = True End Sub Private Sub TextBox16_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) modFlag = True End Sub Private Function errCHeck(tx As MSForms.TextBox) As Boolean If tx.Value = "" Then Exit Function If Not IsNumeric(tx.Value) Then MsgBox "予算は 9999 または 9,9999 の形で入力してください" errCHeck = True Else tx.Value = Format(tx.Value, "#,###") modFlag = True End If End Function （β） 2016/08/07(日) 19:55 ---- ↑ あっ!! 担当者を表示項目にしたので、もしリストボックスから選ばずに、まるまる生入力して新規追加を行うと担当者が空白のままですね。まぁ。とりあえず、何か選んで打ち直して試行してください。その部分、改訂次第、当該部分を連絡します。（β） 2016/08/07(日) 20:01 ---- β様実はまたコメントがかぶってました! 改めて新しいコードで実行したところ、 〚実行時エラー1004 選択されたセル範囲に対してこの操作を実行することはできません。対象範囲のデータのあるセルを1つ選択してから試して下さい〛 と出ました(>_<) F8を押して、で個別に確認したところ、 > clearText > ListBox1.RowSource = "" > shW.Range("A1").CurrentRegion.ClearContents > wPos0.Resize(, 2).Value = shM.Range("A1:B1").Value > wPos0.Offset(1).Resize(, 2).Value = Array(ComboBox1.Value, ComboBox2.Value) > shM.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _ > CriteriaRange:=wPos0.Resize(2, 2), CopyToRange:=shW.Range("A1"), Unique:=False の > shM.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _ > CriteriaRange:=wPos0.Resize(2, 2), CopyToRange:=shW.Range("A1"), Unique:=False でエラーが表示されました。まだコードの意味を追いきれてないのですが、フィルター結果の部分ということでしょうか???(;_;) （ゆう） 2016/08/07(日) 20:43 ---- もともとフィルターオプションを使ったコード提示でしたが、担当シートの登録を取り込むためにフィルターオプションをやめ、（β） 2016/08/07(日) 19:55 でアップしたコードに全面改定しています。指摘のコードは、最初のコードですね。（β） 2016/08/07(日) 19:55 のコードですべて入れ替えしてください。で、あわせて、（β） 2016/08/07(日) 20:01 でコメントした修正。（β） 2016/08/07(日) 19:55 のコードに対して、 Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) modFlag = True End Sub これを消してください。さらに、Private Sub setコンボ2() を以下に入れ替えてください。 Private Sub setコンボ2() Dim j As Long Dim c As Range ComboBox2.Clear If ComboBox1.Value <> "" Then j = ComboBox1.ListIndex + 12 For Each c In shP.Range(shP.Cells(2, j), shP.Cells(Rows.Count, j).End(xlUp)) ComboBox2.AddItem c.Value Next End If End Sub わかりにくければ、コードフルセット、アップしますが。（β） 2016/08/07(日) 22:30 ---- βさまごめんなさい、ちょっと分からなくなったので、お手数ですがコードフルセットをアップしていただけますでしょうか??? 本当に何から何まですみません(>_<) （ゆう） 2016/08/07(日) 22:51 ---- 現在のユーザーフォームモジュールの内容をすべて消して、以下を貼り付けてください。なお、（β） 2016/08/07(日) 19:55 のレスの最初のほうでコメントしたことをよく読んで試してみてくださいね。 Option Explicit Const lstCol As Long = 16 'リスト最終列列番号 "P" '● Dim numCol As Long Dim shM As Worksheet Dim shW As Worksheet Dim shP As Worksheet Dim wPos0 As Range Dim wPos1 As Range Dim wPos2 As Range Dim modFlag As Boolean Private Sub UserForm_Initialize() Dim x As Long Set shM = Sheets("Sheet1") '★ Set shW = Sheets("Sheet2") '★ Set shP = Sheets("担当") numCol = lstCol + 1 '作業列番号 Set wPos0 = shW.Cells(1, numCol).Offset(, 2) '抽出用作業域 Set wPos1 = shW.Cells(1, numCol).Offset(, 5) 'ComboBox1用作業域 Set wPos2 = shW.Cells(1, numCol).Offset(, 7) 'COmboBox2用作業域 shW.Cells.Clear ListBox1.ColumnCount = lstCol ListBox1.ColumnHeads = True With TextBox1 '担当者は表示項目 .TabStop = False .Locked = True End With With ComboBox1 .MatchRequired = True .List = shP.Range("A2", shP.Range("A" & Rows.Count).End(xlUp)).Value End With reset For x = 1 To lstCol Me.Controls("Label" & x).Caption = shM.Cells(1, x).Value Next End Sub Private Sub ComboBox1_Change() If Me.Tag = "Skip" Then Exit Sub Me.Tag = "Skip" ComboBox2.Clear setコンボ2 makeList TextBox1.Value = ComboBox1.Value Me.Tag = "" End Sub Private Sub ComboBox2_Change() If Me.Tag = "Skip" Then Exit Sub Me.Tag = "Skip" makeList Me.Tag = "" End Sub Private Sub ListBox1_Click() Dim x As Long Dim i As Long If Me.Tag = "Skip" Then Exit Sub If modFlag Then If MsgBox("変更済みの項目がありますが、選ばれたデータで書き換えますか?", vbYesNo) = vbNo Then Exit Sub End If i = ListBox1.List(ListBox1.ListIndex, numCol - 1) '選択行の元シート上の番号 For x = 1 To lstCol Me.Controls("TextBox" & x).Value = shM.Cells(i, x).Text Next modFlag = False End Sub Private Sub CommandButton1_Click() '更新 Dim i As Long If ListBox1.ListIndex < 0 Then MsgBox "データが選択されていません" Exit Sub End If i = ListBox1.List(ListBox1.ListIndex, numCol - 1) '選択行の元シート上の番号 Text2Sheet i reset End Sub Private Sub CommandButton2_Click() '新規追加 If ComboBox1.ListIndex < 0 Then MsgBox "担当が選ばれていません" Exit Sub End If Text2Sheet shM.Range("A" & Rows.Count).End(xlUp).Offset(1).Row reset End Sub Private Sub CommandButton3_Click() '挿入 Dim i As Long If ListBox1.ListIndex < 0 Then MsgBox "データが選択されていません" Exit Sub End If i = ListBox1.List(ListBox1.ListIndex, numCol - 1) '選択行の元シート上の番号 shM.Rows(i + 1).Insert Text2Sheet i + 1 reset End Sub Private Sub CommandButton4_Click() '削除 Dim i As Long If ListBox1.ListIndex < 0 Then MsgBox "データが選択されていません" Exit Sub End If If modFlag Then If MsgBox("変更済みの項目がありますが、無視して選ばれたデータを削除しますか?", vbYesNo) = vbNo Then Exit Sub End If i = ListBox1.List(ListBox1.ListIndex, numCol - 1) '選択行の元シート上の番号 shM.Rows(i).Delete reset End Sub Private Sub reset() Dim j As Long Dim z As Variant Dim sv2 As String Me.Tag = "SKip" '====新規取引先なら、担当シートに追加 If ComboBox1.ListIndex >= 0 Then j = ComboBox1.ListIndex + 12 z = Application.Match(TextBox2.Value, shP.Range(shP.Cells(2, j), shP.Cells(Rows.Count, j).End(xlUp)), 0) If IsError(z) Then shP.Cells(Rows.Count, j).End(xlUp).Offset(1).Value = TextBox2.Value End If End If '===================================== clearText sv2 = ComboBox2.Value set連番 setコンボ2 ComboBox2.Value = sv2 makeList Me.Tag = "" End Sub Private Sub set連番() With shM.Range("A1").CurrentRegion .Cells(1, numCol).Value = 1 .Cells(1, numCol).Resize(.Rows.Count).DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Trend:=False End With End Sub Private Sub setコンボ2() Dim j As Long Dim c As Range ComboBox2.Clear If ComboBox1.Value <> "" Then j = ComboBox1.ListIndex + 12 For Each c In shP.Range(shP.Cells(2, j), shP.Cells(Rows.Count, j).End(xlUp)) ComboBox2.AddItem c.Value Next End If End Sub Private Sub makeList() clearText ListBox1.RowSource = "" shW.Range("A1").CurrentRegion.ClearContents wPos0.Resize(, 2).Value = shM.Range("A1:B1").Value wPos0.Offset(1).Resize(, 2).Value = Array(ComboBox1.Value, ComboBox2.Value) shM.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=wPos0.Resize(2, 2), CopyToRange:=shW.Range("A1"), Unique:=False With shW.Range("A1").CurrentRegion If .Rows.Count > 1 Then ListBox1.RowSource = .Offset(1).Resize(.Rows.Count - 1).Address(External:=True) Me.Tag = "" If .Rows.Count = 2 Then ListBox1.ListIndex = 0 End With End Sub Private Sub clearText() Dim x As Long For x = 1 To lstCol Me.Controls("TextBox" & x).Value = "" Next modFlag = False End Sub Private Sub Text2Sheet(n As Long) Dim x As Long For x = 1 To lstCol shM.Cells(n, x).Value = Me.Controls("TextBox" & x).Value Next End Sub ' Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) ' modFlag = True ' End Sub Private Sub TextBox2_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) modFlag = True End Sub Private Sub TextBox3_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox3) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox4_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox4) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox5_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox5) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox6_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox6) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox7_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox7) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox8_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox8) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox9_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox9) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox10_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox10) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox11_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox11) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox12_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox12) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox13_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox13) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox14_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) If errCHeck(TextBox14) Then Cancel = True Exit Sub End If End Sub Private Sub TextBox15_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) modFlag = True End Sub Private Sub TextBox16_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean) modFlag = True End Sub Private Function errCHeck(tx As MSForms.TextBox) As Boolean If tx.Value = "" Then Exit Function If Not IsNumeric(tx.Value) Then MsgBox "予算は 9999 または 9,9999 の形で入力してください" errCHeck = True Else tx.Value = Format(tx.Value, "#,###") modFlag = True End If End Function （β） 2016/08/07(日) 23:15 ---- β様 >なお、（β） 2016/08/07(日) 19:55 のレスの最初のほうでコメントしたことをよく読んで試してみてくだ>さいね。これは、label1‾16、textbox1‾16を事前に作っておくということでしょうか??(>_<) （作成してフォームに配置してます）実は先ほど頂いたフルコードを前のは消した上で貼り付けたのですが、 〚実行時エラー1004 選択されたセル範囲に対してこの操作を実行することはできません。対象範囲のデータのあるセルを1つ選択してから試して下さい〛 が出ました。エラー箇所は >Private Sub makeList() の >shM.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _ > CriteriaRange:=wPos0.Resize(2, 2), CopyToRange:=shW.Range("A1"), Unique:=False でした。う〜ん、ごめんなさい、私がよく分かってないせいで、エラーが出てる気がします。。。ほんとに何度もすみません(>_<)/ （ゆう） 2016/08/08(月) 00:02 ---- βさますみません、ふとした疑問なのですが、今回フォームのコード上で、実行ボタンを押して上記のエラーになったのですが、ユーザフォームのVBAの実行はこれで合ってますか?(´・Д・)」（ゆう） 2016/08/08(月) 00:13 ---- エラーはユーザーフォームを表示しようとしたタイミングででているのですね? （つまり、ユーザーフォームが表示されない状態でエラーになるんですね?）このエラーが出たときの shM つまり "Sheet1"（元リストのシート）ですけど、ちゃんとデータが存在するシートでしょうか? （β） 2016/08/08(月) 01:05 ---- βさまわわわ、いま気づきました!Sheet1にシート名を変更したのですが、違うシートでした!! 失礼いたしました!(>_<) 正しいデータがあるシート名に変更しました! すると、”抽出した範囲にはフィールド名がないか無効なフィールドです”とでます。あと、これは前からなのですが、フォームのコンボボックス1（担当名）はプルダウンから選べない（下三角のボタンを押しても空白が出る）のですが、これは出ないものでしょうか??? 何度もすみません(;_;) （ゆう） 2016/08/08(月) 07:07 ---- なかなか、すんなりとはいきませんね。こちらでは、全く問題なく処理できていますので、実際のシート上のなにがしかの値がある領域とこちらが想像しているものとの間に何か差異があるのだと思います。少し決め打ちすぎるのですが、makeList を以下で置き換えてみてください。 Private Sub makeList() clearText ListBox1.RowSource = "" shW.Cells.ClearContents wPos0.Resize(, 2).Value = shM.Range("A1:B1").Value wPos0.Offset(1).Resize(, 2).Value = Array(ComboBox1.Value, ComboBox2.Value) shM.Range("A1").CurrentRegion.Resize(, numCol).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=wPos0.Resize(2, 2), CopyToRange:=shW.Range("A1"), Unique:=False With shW.Range("A1").CurrentRegion If .Rows.Count > 1 Then ListBox1.RowSource = .Offset(1).Resize(.Rows.Count - 1).Address(External:=True) Me.Tag = "" If .Rows.Count = 2 Then ListBox1.ListIndex = 0 End With End Sub >>あと、これは前からなのですが、フォームのコンボボックス1（担当名）はプルダウンから >>選べない（下三角のボタンを押しても空白が出る）のですが、これも不思議ですねぇ。担当名リストは "担当" という名前のシートの A2から下に、記載されているんですよね? ★ところで、担当シートからのコンボボックスセットに変更した結果、変数のwPos1とwPos2は、もう使っていません。なので、先頭の Dim wPos1 As Range Dim wPos2 As Range および Initializeの中の Set wPos1 = shW.Cells(1, numCol).Offset(, 5) 'ComboBox1用作業域 Set wPos2 = shW.Cells(1, numCol).Offset(, 7) 'COmboBox2用作業域これは消しておいてください。（あっても害にはなりませんが、ややこしいので）（β） 2016/08/08(月) 10:42 ---- βさま大変遅くなり、申し訳ございません! 私が未熟なっばかりに、なんだかうまくいってないですね(>_<) 8/8の10:42に頂いたコードに直しましたが、同じエラーでした。う〜ん、やはり領域の違いでしょうか?? >担当名リストは "担当" という名前のシートの A2から下に、記載されているんですよね? そうです、担当シートのA2から下に記載してますコンボボックス2と取引先もL列、M、N・・・と、列単位で各担当の取引先を入れてます。今のところAP列まで各担当名と取引先がありますが、列数は変動します。（1行目は担当者名、2行目以降に取引先名がはいってます）（ゆう） 2016/08/08(月) 22:12 ---- 問題は2つあるわけですね。 1.AdvancedFilter でエラー。ユーザーフォームが表示されない時点でのエラーですね? エラーで、いったん終わらせた後、作業シート（コードでは "Sheet2" にしています）を見てください。 A列からQ列まで、どうなってるか教えてください。（空白のはずなんですが）また、S1:T2 はどうなっていますか? S1 が元シート（コードでは "Sheet1")のA1の値、T1 が元シートの B1の値。 S2:T2 は空白になっていますか? 2.ComboBox1 ▼でリストを表示しても空白になっている。まったく、原因がわかりません。 Initializeで With ComboBox1 .MatchRequired = True .List = shP.Range("A2", shP.Range("A" & Rows.Count).End(xlUp)).Value End With このコードでリストをセットしています。 shP(担当シート）のA2から下にいくつか担当コードがあるなら、それがセットされるはず。。というかセットされない（空白になる）ということはありえないのですが・・・（β） 2016/08/08(月) 22:31 ---- β様お手数おかけしてます(>_<) 1、ユーザーフォームが表示されない時点でのエラーですエラー後の作業シートは1行名のみ表示あります。 A1:担当 B1:会社名 C1:平成28年4月 D1:5月 E1:6月 F1:7月 G1:8月 H1:9月 I1:10月 J1:11月 K1:12月 L:平成29年1月 M1:2月 N1:3月【 O1:グループ【関数あり】 P1:新規 Q1:1 R1: S1:担当 T1:会社名 1行名はR1のみ空白でした。 2行目以下は、どの列もすべて空白です。 2、コンボボックスは・・・謎すぎます。以前作った Private Sub UserForm_Initialize() Dim LastRow As Long LastRow = Sheets("担当").Cells(Rows.Count, "A").End(xlUp).Row ComboBox1.RowSource = "担当!A2:A" & LastRow End Sub Private Sub ComboBox1_Change() ComboBox2.Clear Worksheets("担当").Select myCol = ComboBox1.ListIndex + 12 For i = 2 To Cells(Rows.Count, myCol).End(xlUp).Row ComboBox2.AddItem Cells(i, myCol).Value Next End Sub だと、表示はされたのですが・・・（ゆう） 2016/08/08(月) 23:30 ---- AdvancedFilterのエラーについては、そちらのシートと、こちらとの違いが1つありそうなので解決できると思います。以下、教えてください。元シートの 4月〜3月のタイトル欄ですが、ここは、日付型データなのですか? で、表示書式で m月といったようになっているのですかね? でも、ちょっちわからないのが、作業シートに展開された L1、これが 1月ではなく平成29年1月になってますね? 元シートの L1 も平成29年1月なのですか? （C1 も、そうですね。ここも教えてください）で、ComboBox1 のリストの件は、まだ悩ましいのです。もし、AddItemで解決するなら AddItem に変えますけど担当シートの A2 から下の担当者名、ここは【値】ですか? それとも【数式】ですか? もう1つ、▼のドロップダウンで選べないといわれていますが、上にスクロールすると、上のほうに表示されているということはないですか? （β） 2016/08/09(火) 08:16 ---- もう1つ。現在のブックの標準モジュールに Sub 確認テスト() MsgBox Sheets("担当").Range("A" & Rows.Count).End(xlUp).Row End Sub これを書いて実行して、でてきた数字が、担当名の最後の行かどうかを確認してください。（β） 2016/08/09(火) 08:31 ---- β様遅くなり、大変申し訳ございません! >元シートの 4月〜3月のタイトル欄ですが、ここは、日付型データなのですか? > で、表示書式で m月といったようになっているのですかね? 日付型になりますが、この4月は別シートの日付を参照し（=別シート!セルみたいな感じ）、 5月以降はEDATE関数で1か月後にしてます。 >でも、ちょっちわからないのが、作業シートに展開された L1、これが 1月ではなく平成29年1月になっ>てますね? > 元シートの L1 も平成29年1月なのですか? そうですね、最初の4月と年度が替わる1月だけ、セルの表示形式で、平成が表示されるようにしてます。 >担当シートの A2 から下の担当者名、ここは【値】ですか? それとも【数式】ですか? >もう1つ、▼のドロップダウンで選べないといわれていますが、上にスクロールすると、上のほうに表示さ>れているということはないですか? 担当シートの担当者名はすべて値のみです。上のほうに特に表示はないです〜標準モジュールでの確認テストですが、出てきた数字は最後の行でした! （ゆう） 2016/08/09(火) 21:33 ---- 日付欄の件はわかりました。ただ、それでもなぜエラーになるのかが、ちょっとわからないのですけど、連絡もらったことを踏まえて少し悩んでみます。 ComboBox1 の件、 >>出てきた数字は最後の行でした! 了解です。了解なんですが、ちょっと不思議なことが。ユーザーフォームが表示される前に、そちらではエラーになっているんですよね。ということは、ユーザーフォームは表示されないわけで、当然、その上にある ComboBox1 も表示されませんので ▼のクリックもできないはずですけど? いずれにしても気持ちは悪いのですが、AddItemに戻しましょうか。 Initializeルーティンを以下で置き換え。（でも、その前にエラーになるので、この変更でOKかどうかはわからないはずですが） Private Sub UserForm_Initialize() Dim x As Long Dim c As Range Set shM = Sheets("Sheet1") '★ Set shW = Sheets("Sheet2") '★ Set shP = Sheets("担当") numCol = lstCol + 1 '作業列番号 Set wPos0 = shW.Cells(1, numCol).Offset(, 2) '抽出用作業域 shW.Cells.Clear ListBox1.ColumnCount = lstCol ListBox1.ColumnHeads = True With TextBox1 '担当者は表示項目 .TabStop = False .Locked = True End With With ComboBox1 .MatchRequired = True For Each c In shP.Range("A2", shP.Range("A" & Rows.Count).End(xlUp)) .AddItem c.Value Next End With reset For x = 1 To lstCol Me.Controls("Label" & x).Caption = shM.Cells(1, x).Value Next End Sub （β） 2016/08/09(火) 22:25 ---- β様 >ユーザーフォームが表示される前に、そちらではエラーになっているんですよね。 > ということは、ユーザーフォームは表示されないわけで、当然、その上にある ComboBox1 も表示されませ >んので ▼のクリックもできないはずですけど? コンボボックスの件ですが、エラーになる前（VBAの再生ボタンを押す前）にユーザーフォームを表示させて▼のクリックを押したら、特に何も出なかったので・・・あれ、もしかして手順が違いますか??(?_?) 前にコンボボックスだけ作った時は、コード再生ボタンを押さなくても、 ▼で担当が出た・・・はずだったので、同様にできるのかな?と思いまして。。。（ゆう） 2016/08/09(火) 23:28 ---- VBAの再生ボタンとは? フィルターオプションでエラーになる前はユーザーフォームは表示されていませんしエラーになれば、リセットされますから、ユーザーフォームは表示されませんので、何かの勘違い? いずれにしても、フィルターオプションでエラーになるのをとりあえず回避する手立てを考えてみます。（β） 2016/08/10(水) 01:01 ---- 通常、数式があろうと、日付表示書式が設定されていようとフィルターオプションはエラーにはならないと理解しているんですが、実際問題として、同じ環境にして実行すると、こちらでもエラー再現します。なので、インチキですが、無理やりエラー回避させてください。 makelist を以下で置き換えてください。 Private Sub makeList() Dim sv As Variant Dim c As Range clearText ListBox1.RowSource = "" shW.Cells.ClearContents wPos0.Resize(, 2).Value = shM.Range("A1:B1").Value wPos0.Offset(1).Resize(, 2).Value = Array(ComboBox1.Value, ComboBox2.Value) '====エラー回避対応 With shM.Range("A1").Resize(, numCol) sv = .Formula For Each c In .Cells c.Value = c.Value Next End With '================= shM.Range("A1").CurrentRegion.Resize(, numCol).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=wPos0.Resize(2, 2), CopyToRange:=shW.Range("A1"), Unique:=False '====エラー回避対応の復元 shM.Range("A1").Resize(, numCol).Formula = sv '================= With shW.Range("A1").CurrentRegion If .Rows.Count > 1 Then ListBox1.RowSource = .Offset(1).Resize(.Rows.Count - 1).Address(External:=True) Me.Tag = "" If .Rows.Count = 2 Then ListBox1.ListIndex = 0 End With End Sub （β） 2016/08/10(水) 01:15 ---- こちらにしてください。なお、フィルターオプションのタイトル行は数式だと具合悪いようですね。勉強になりました。 Private Sub makeList() Dim sv As Variant clearText ListBox1.RowSource = "" shW.Cells.ClearContents wPos0.Resize(, 2).Value = shM.Range("A1:B1").Value wPos0.Offset(1).Resize(, 2).Value = Array(ComboBox1.Value, ComboBox2.Value) '====エラー回避対応 With shM.Range("A1").Resize(, numCol) sv = .Formula .Value = .Value End With '================= shM.Range("A1").CurrentRegion.Resize(, numCol).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=wPos0.Resize(2, 2), CopyToRange:=shW.Range("A1"), Unique:=False '====エラー回避対応の復元 shM.Range("A1").Resize(, numCol).Formula = sv '================= With shW.Range("A1").CurrentRegion If .Rows.Count > 1 Then ListBox1.RowSource = .Offset(1).Resize(.Rows.Count - 1).Address(External:=True) Me.Tag = "" If .Rows.Count = 2 Then ListBox1.ListIndex = 0 End With End Sub （β） 2016/08/10(水) 01:43 ---- β様またまた遅れてしまい申し訳ございません! ありがとうございます!! 作成頂いたコードで無事動きました!!! 私の力不足でたくさんお手間をおかけして申し訳ございません。何から何まで本当にありがとうございます! 感動してます! ぜひ師匠と呼ばせてください(>_<) （ゆう） 2016/08/10(水) 22:21 ...; https://www.excel.studio-kazu.jp/wiki/kazuwiki/201608/20160805223155.txt - [detail] - similar

PREV NEXT

訪問者：カウンタ