[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ユーザーフォームからの転記がうまくいきません』（peridot）
本当に何度もすみません [[20120410105511]] この続きです。
データシート「箱サンプル」にユーザーフォームからデータを入力して転記したいのですが、どうしてもうまくいきません。
★「箱サンプル」シートレイアウト
A B C D E F G H I J K L 1 作業簿_SK 合計 2 記号 媒体名 件数 記号 媒体名 件数 記号 媒体名 件数 3 SK2 KZ 2 SK KZ 2 4 SK1 HY 82 SK2 HY 4 SK HY 86 5 SK1 FR 11 SK FR 11 ： 19 20 21 作業簿_KK 22 記号 媒体名 件数 記号 媒体名 件数 記号 媒体名 件数 23 VA1 KK 1516 VA2 KK 224 VA KK 1740 24 VE1 KK 9 VE2 KK 4 VE KK 13 ： 35 36 37 作業簿_その他 38 記号 媒体名 件数 記号 媒体名 件数 記号 媒体名 件数 39 VS1 10P 6192 VS2 10P 672 VS 10P 6864 40 VS3 10P 1008 VS ： 49
★ユーザーフォームのレイアウト
TextBox1（日付） ："F1"セルに入力
ComboBox3（分類） ：入力する段落を選ぶ
ComboBox1（記号） ：記号を選ぶ
ComboBox2（枝番） ：記号の次に入る数字を選ぶ ※ComboBox1（記号）&ComboBox2（枝番）がA列またはE列に入ります。 （例）記号：SK、枝番：1 → A列に「SK1」
ComboBox4（媒体名）：B列またはF列に入ります TextBox4（数量） ：C列またはG列に入ります ： ComboBox11（媒体名） TextBox11（数量） ※「媒体名」と「数量」を入れるコンボボックスとテキストボックスは各8個
CommandButton1（入力）：ユーザーフォームの内容を「箱サンプル」シートに転記します
「作業簿_SK」の入力欄は3～19行目まで 「作業簿_KK」の入力欄は23～35行目まで 「作業簿_その他」の入力欄は39～49行目までです。
「記号」の末尾の数字が奇数のものはA～C列に、偶数のものはE～G列に入力します。
それで、下記のコードを書きました。
Private Sub CommandButton1_Click()
Dim c2 As Long
Dim a As Integer
With Sheets("箱サンプル")
.Range("F1") = CDate(TextBox1.Value)
c2 = Me.ComboBox2.Value
a = c2 Mod 2
If a <> 0 Then
Call 奇数枝番入力
Else
Call 偶数枝番入力
End If
End With
End Sub
Private Sub 奇数枝番入力()
Dim i As Long
Dim c As Long
Dim kigo1 As String
With Sheets("箱サンプル")
kigo1 = ComboBox1.Value & ComboBox2.Value
If Me.ComboBox3.Text = "作業簿_SK" Then
For i = 3 To 19
For c = 4 To 11
If Controls("ComboBox" & c) = "" Then Exit For
.Cells(i, 1).Value = kigo1
.Cells(i, 2).Value = Controls("ComboBox" & c).Value
.Cells(i, 3).Value = Controls("TextBox" & c).Value
Next c
Next i
ElseIf Me.ComboBox3.Text = "作業簿_KK" Then
For i = 23 To 35
For c = 4 To 11
If Controls("ComboBox" & c) = "" Then Exit For
.Cells(i, 1).Value = kigo1
.Cells(i, 2).Value = Controls("ComboBox" & c).Value
.Cells(i, 3).Value = Controls("TextBox" & c).Value
Next c
Next i
ElseIf Me.ComboBox3.Text = "作業簿_その他" Then
For i = 39 To 49
For c = 4 To 11
If Controls("ComboBox" & c) = "" Then Exit For
.Cells(i, 1).Value = kigo1
.Cells(i, 2).Value = Controls("ComboBox" & c).Value
.Cells(i, 3).Value = Controls("TextBox" & c).Value
Next c
Next i
Else
MsgBox "作業分類を選択してください"
End If
End With
End Sub
Private Sub 偶数枝番入力()
Dim i As Long
Dim c As Long
Dim kigo1 As String
With Sheets("箱サンプル")
kigo1 = ComboBox1.Value & ComboBox2.Value
If Me.ComboBox3.Text = "作業簿_SK" Then
For i = 3 To 19
For c = 4 To 11
If Controls("ComboBox" & c) = "" Then Exit For
.Cells(i, 5).Value = kigo1
.Cells(i, 6).Value = Controls("ComboBox" & c).Value
.Cells(i, 7).Value = Controls("TextBox" & c).Value
Next c
Next i
ElseIf Me.ComboBox3.Text = "作業簿_KK" Then
For i = 23 To 35
For c = 4 To 11
If Controls("ComboBox" & c) = "" Then Exit For
.Cells(i, 5).Value = kigo1
.Cells(i, 6).Value = Controls("ComboBox" & c).Value
.Cells(i, 7).Value = Controls("TextBox" & c).Value
Next c
Next i
ElseIf Me.ComboBox3.Text = "作業簿_その他" Then
For i = 39 To 49
For c = 4 To 11
If Controls("ComboBox" & c) = "" Then Exit For
.Cells(i, 5).Value = kigo1
.Cells(i, 6).Value = Controls("ComboBox" & c).Value
.Cells(i, 7).Value = Controls("TextBox" & c).Value
Next c
Next i
Else
MsgBox "作業分類を選択してください"
End If
End With
End Sub
前の人が作った別のコードを見ながら書いたのですが、「媒体名」と「数量」が、最後の コンボボックス＆テキストボックスのものだけが指定した範囲（SKだったら3～19行目まで）に ずらっと入ります。
For文の順番を入れ替えたりしてみましたがダメでした。
どこがおかしいのでしょうか。
要件が見えないところもあるけど、お試し版として。 なお、C列、G列の件数は、何を入れるのかわからないので対処していない。 また合計欄も対処していない。 とにかく、動きがイメージにあっているかどうかチェックしてね。
Private Sub CommandButton1_Click()
Dim f As Long, e As Long
Dim x As Long, y As Long
Dim myCat As String, myCode As String, myMedia As String
Dim c2 As String
Dim i As Long
myCat = ComboBox3.Value
myCode = ComboBox1.Value
c2 = ComboBox2.Value
If Len(myCat) = 0 Or Len(myCode) = 0 Or Len(c2) = 0 Then
MsgBox "分類、記号、枝番 のいずれかが選択されていません"
Exit Sub
End If
Select Case myCat
Case "作業簿_SK"
f = 3: e = 19
Case "作業簿_KK"
f = 23: e = 35
Case "作業簿_その他"
f = 39: e = 49
End Select
If f = 0 Then
MsgBox "この分類コードはサポートされていません"
Exit Sub
End If
If CLng(c2) Mod 2 = 0 Then
x = 5 'E列
Else
x = 1 'A列
End If
With Sheets("箱サンプル")
For i = 4 To 11
myMedia = Me.Controls("ComboBox" & i).Value
If Len(myMedia) > 0 Then
y = .Cells(e + 1, x).End(xlUp).Row + 1
If y > e Then
MsgBox myCat & "/" & myCode & "/" & myMedia & "を転記するスペースがありません"
Else
If y < f Then y = f
.Cells(y, x).Value = myCode
.Cells(y, x + 1).Value = myMedia
End If
End If
Next
End With
End Sub
(ぶらっと)
↑ 件数はTextBoxからだったんだね。それとアップしたコード、記号にCOmboBox1の値をくっつけるのを忘れている。 後ほど、改訂版をアップするけど、まず、アップしたもので動きがいいにかわるいのいか確認お願い。
(ぶらっと)
改訂版
Private Sub CommandButton1_Click()
Dim f As Long, e As Long
Dim x As Long, y As Long
Dim myCat As String, myCode As String, myMedia As String, myQty As String
Dim c2 As String
Dim i As Long
myCat = ComboBox3.Value
myCode = ComboBox1.Value & ComboBox2.Value
c2 = ComboBox2.Value
If Len(myCat) = 0 Or Len(myCode) = 0 Or Len(c2) = 0 Then
MsgBox "分類、記号、枝番 のいずれかが選択されていません"
Exit Sub
End If
Select Case myCat
Case "作業簿_SK"
f = 3: e = 19
Case "作業簿_KK"
f = 23: e = 35
Case "作業簿_その他"
f = 39: e = 49
End Select
If f = 0 Then
MsgBox "この分類コードはサポートされていません"
Exit Sub
End If
If CLng(c2) Mod 2 = 0 Then
x = 5 'E列
Else
x = 1 'A列
End If
With Sheets("箱サンプル")
For i = 4 To 11
myMedia = Me.Controls("ComboBox" & i).Value
myQty = Me.Controls("TextBox" & i).Value
If Len(myMedia) > 0 Then
y = .Cells(e + 1, x).End(xlUp).Row + 1
If y > e Then
MsgBox myCat & "/" & myCode & "/" & myMedia & "を転記するスペースがありません"
Else
If y < f Then y = f
.Cells(y, x).Value = myCode
.Cells(y, x + 1).Value = myMedia
.Cells(y, x + 2).Value = myQty
End If
End If
Next
End With
End Sub
(ぶらっと)
(ぶらっと)様ありがとうございます。
いただいたコードで動きました！
ただ、件数を自力で入力しようとしたら、転記はできるものの「型が一致しません」のエラーが出ます。
Dim qty As Long
を追加し、
With Sheets("箱サンプル")
For i = 4 To 11
myMedia = Me.Controls("ComboBox" & i).Value
qty = Me.Controls("TextBox" & i).Value
If Len(myMedia) > 0 Then
y = .Cells(e + 1, x).End(xlUp).Row + 1
If y > e Then
MsgBox myCat & "/" & myCode & "/" & myMedia & "を転記するスペースがありません"
Else
If y < f Then y = f
.Cells(y, x).Value = kigo1 '←記号と枝番をくっつけたもの
.Cells(y, x + 1).Value = myMedia
.Cells(y, x + 2).Value = qty '←件数
End If
End If
Next
End With
これで、 .Cells(y, x + 2).Value = qty が反転して「型が一致しません」になります。（シートには入力されています）
それと合計欄の出し方で迷っているのですが、今まではシートに全部ベタ打ちで、 SK1,SK2などから右の数値を削除したものをJ列の同じ行に表示、L列の「件数」で「=C列+G列」で合計を出していました。 それが今度は「記号」部分を上詰めでA～G列に入力するので、必ずしも同じ行に同じ組合せがあるとは限らないことになります。 なので、今度からはA～C列およびE～G列の中で「記号（枝番を抜いた状態）＆媒体」の組合せが同じものを抽出して 合計件数をJ～L列に出そうと思うのですが、これもマクロの方が効率がよいでしょうか。 そういうのができる関数があるのかどうかをよく分からないのでどうしようか考えています。
★書いていて衝突しました！ 今から改訂版コードを試してみます！
(peridot)
改訂版コードでうまくいきました。
ただ、コマンドボタン１（入力）をクリックした後、重複入力を防ぐために一旦ユーザーフォームの内容をクリアしようと
Dim ctrl As Control
For Each ctrl In Me.Controls
If TypeName(ctrl) = "TextBox" Or TypeName(ctrl) = "ComboBox" Then _
ctrl.Value = vbNullString
Next
これを追加したら
Private Sub ComboBox1_Change()
Dim i As Long
Dim v As Variant
If Me.Tag = "Skip" Or ComboBox1.ListIndex < 0 Then Exit Sub
v = dic(ComboBox3.Value)(ComboBox1.Value).keys
Me.Tag = "Skip"
For i = 4 To 11
With Me.Controls("ComboBox" & i)
.Value = Empty
.List = dic(ComboBox3.Value)(ComboBox1.Value).keys ←☆ここ
End With
Next
Me.Tag = Empty
End Sub
上記部分で「型が一致しません」のエラーになります。
前に作ったユーザーフォームではクリアできたのですが、構造がよく分かっていないので・・・
どうやったらクリアできるのでしょうか？
(peridot)
此れ今見てて疑問に思ったのですが？ 前回のUserFormの作りから言って、此れで入力するのは無理が在る様な気がしますが？
何故かと言うと、「記号」はComboBox1で1回だけ選択されますが？ 例えば、「作業簿_KK」に就いては、「VA」「VE」の2つを入力しなければ成らない様です 詰まり、現状のUserFormでは2度「作業簿_KK」欄に入力しなければ成らなく成ります この辺のカラクリは如何するのでしょうか？
だとしたら、J、K、L列の事も含めて考え方を代えたら如何でしょう？ 入力される欄「作業簿_SK」「作業簿_KK」「作業簿_その他」の位置は決まっている様ですし 1行づつの入力されたら使い難いですか？
詰まり、ComboBox3で「分類」を選択→ComboBox1で「記号」を選択→ComboBox2で「枝番」を選択（1と3だけ） →ComboBox4で「媒体名」を選択→TextBox2でC列の件数入力→TextBox3でG列の件数入力 →CommandButton1でデータを「分類」欄の最終行に出力 G列の件数入力が無ければE、F、Gの出力は無し有れば、「記号」に就いては「2」を付加し F列はComboBox4の「媒体名」を使用で善いのでは？ この出力の時にJ、K、L列も出力すれば、殆ど今まで通りの表が出力されると思いますが？
(Bun)
(Bun)様
ご指摘ありがとうございます。
私も先程考えていたのですが…
このユーザーフォームを作った際、「作業簿_SK」を念頭において作ったためこのような作りになったのですが、それ以外の「作業簿」の場合に ユーザーフォームでの入力がやや面倒になることが実際に動かしてみて分かりました。
元々の「単価マスタ」が、
・「作業簿_SK」の分類については、記号は「SK」で統一、「媒体名」が17ほどある ・「作業簿_KK」の分類については、記号が12種ほどあり、「媒体名」は現在2種のみ ・「作業簿_その他」については、記号・媒体名ともに規則性なし。現在10種ほどの組合せがある
このような構成になっています。
なので今回のユーザーフォームは、「SK」を入力する際はまとめて入力できるのですが、「KK」と「その他」は 一つずつ入力しなければいけない仕様になっており、どのようにしたものか考えていたところです。
(Bun)様のご提案も含めて考えます。
(peridot)
後、もう一つの案は、入力行が最大で17行？程度なので 先に言った1行入力のコントロールを17組分？作って一括で「分類」欄を入力するかです？ この場合でもコントロールの数はそれほどでは無い様な気がしますので 可能かと思いますが？
(Bun)
そちらで追加してエラーになったところについては、明日にでも時間を取って、対処方法は連絡する。 今回も前回も、そちらの仕様というかＵＩに併せてコードを書いたけど、Bunさんも指摘するように こちらで動かしたときに、確かにこの構成自体、必ずしも、操作者の運用面で使いやすいものではないなという印象だった。 Bunさんがアドバイスするとおり、このデータ要件なら、コンボックスから選ぶのではなく、必要な入力項目を すべて、フォーム上に配置して、一括転記のほうがいいように思う。
(ぶらっと)
エラー回避そのものは For Each ctrl In Me.Controls の上に Me.Tag="Skip" で、Next の下に Me.Tag=Empty
(テストしてないんだけど、たぶん大丈夫かな）
フォームというか運用の構成については、実際に、そちらで運用してみて、業務の流れにマッチするのか あるいはマッチしないのか、それを確認しながら、必要なら変更していけばいいと思う。
箱サンプルシート全体を一連の処理で作成するなら、構成はガラっと変えるべきだと思うし そうじゃなく、今回は、この分類と記号に関して、媒体を、これとこれとこれ といったように 入力追加していく運用なのであれば、今の仕様でも、そんなに効率が悪いということでもないかもしれない。
追記） エラー回避という面だけなら、↑の手当でＯＫだけど、本来は、ComboBox3のみにリストを残し ComboBo1,ComboBox4～11のリストは空にしておくことが望ましい。 その手当は、明日に。
(ぶらっと)
↑でもいったことも踏まえて改訂したコード一式を。
ところで、枝番なんだけど、これって、箱サンプルシートで言えば、レイアウト的には行ごとに存在する可能性が あるんだけど、実際は？ 箱シートの１つの分類の中の記号は、全て同じ枝番？それともやはり行ごとに異なる？
なを、何度かいっているけど、もし、この処理が、箱シート全体を作りだすというものなら 構成、デザインをがらっと変えて、少なくとも分類ごとには、一括処理をすることがいいかも。 使ってみて、そう思ったらまた、変更していけばいいと思うけど、その際に私がアップしたコードを コード部品として使っていくということなら、今のコードでやっている構成を参考までに簡単に以下。
・Initialize
３階層ある各コンボボックス用のリストを前もって生成した上で、第１階層のComboBox3にのみリストを登録。 他のコンボボックスのリストは、この時点ではからっぽ。
・ComboBox3_Change
分類が選ばれた時点で、それに紐つく第２階層のリストをComboBox1に登録するとともに ComboBox1の値をクリア、またComboBox4～ComboBox11 のリストと値をクリアしからっぽにする。
・ComboBox1_Change
記号が選ばれた時点で、それに紐つく第３階層のリストをComboBox4～ComboBox11 に登録するとともに ComboBox4～ComboBox11の値をクリア。
・ComboBox4_Change～ComboBox11_Change
選ばれたものを含め、ComboBox4～ComboBox11 で選ばれているメンバーを削除したリストを ComboBox4～ComboBox11 の全てのリストとして再登録。
★留意点
各ComboBoxでは、上記のように値の変更があったときのChangeイベントを受けた処理が実行される。 で、人間の操作としての変更とは別に、コード内で値をクリアするときも、このChangeイベントが発生する。 その場合は、人間の操作により起動される処理をスキップするために Me.Tag (ユーザーフォーム自身が持っているメモのようなもの）に "Skip" と書き込み、値の変更後 Me.Tag と Empty にしておく。 一方、各Changeイベントプロシジャでは最初に Me.Tag が "Skip" なら処理をバイパスするようにしている。
Option Explicit
Dim dic As Object
Private Sub UserForm_Initialize()
Dim c As Range
Dim myCode As String
Dim myCat As String
Dim myMedia As String
Set dic = CreateObject("Scripting.Dictionary")
With Sheets("単価マスタ")
For Each c In .Range("B3", .Range("B" & .Rows.Count).End(xlUp))
With c.EntireRow
myCode = .Range("B1").Value
myCat = .Range("J1").Value
myMedia = .Range("C1").Value
End With
If Not dic.exists(myCat) Then Set dic(myCat) = CreateObject("Scripting.Dictionary")
If Not dic(myCat).exists(myCode) Then
Set dic(myCat)(myCode) = CreateObject("Scripting.Dictionary")
dic(myCat)(myCode)("") = True
End If
dic(myCat)(myCode)(myMedia) = True
Next
End With
Me.Tag = "Skip"
ComboBox3.Clear
ComboBox3.List = dic.keys
Me.Tag = Empty
End Sub
Private Sub ComboBox3_Change()
Dim v As Variant
Dim i As Long
If Me.Tag = "Skip" Or ComboBox3.ListIndex < 0 Then Exit Sub
Me.Tag = "Skip"
ComboBox1.Clear
ComboBox1.List = dic(ComboBox3.Value).keys
For i = 4 To 11
With Me.Controls("ComboBox" & i)
.Clear
.Value = Empty
End With
Next
Me.Tag = Empty
End Sub
Private Sub ComboBox1_Change()
Dim i As Long
Dim v As Variant
If Me.Tag = "Skip" Or ComboBox1.ListIndex < 0 Then Exit Sub
v = dic(ComboBox3.Value)(ComboBox1.Value).keys
Me.Tag = "Skip"
For i = 4 To 11
With Me.Controls("ComboBox" & i)
.Value = Empty
.List = dic(ComboBox3.Value)(ComboBox1.Value).keys
End With
Next
Me.Tag = Empty
End Sub
Private Sub ComboBox4_Change()
Call DeleteMedia(ComboBox4)
End Sub
Private Sub ComboBox5_Change()
Call DeleteMedia(ComboBox5)
End Sub
Private Sub ComboBox6_Change()
Call DeleteMedia(ComboBox6)
End Sub
Private Sub ComboBox7_Change()
Call DeleteMedia(ComboBox7)
End Sub
Private Sub ComboBox8_Change()
Call DeleteMedia(ComboBox8)
End Sub
Private Sub ComboBox9_Change()
Call DeleteMedia(ComboBox9)
End Sub
Private Sub ComboBox10_Change()
Call DeleteMedia(ComboBox10)
End Sub
Private Sub ComboBox11_Change()
Call DeleteMedia(ComboBox11)
End Sub
Private Sub CommandButton1_Click()
Dim f As Long, e As Long
Dim x As Long, y As Long
Dim myCat As String, myCode As String, myMedia As String, myQty As String
Dim c2 As String
Dim i As Long
Dim ctrl As Object
myCat = ComboBox3.Value
myCode = ComboBox1.Value
c2 = ComboBox2.Value
If Len(myCat) = 0 Or Len(myCode) = 0 Or Len(c2) = 0 Then
MsgBox "分類、記号、枝番 のいずれかが選択されていません"
Exit Sub
End If
myCode = myCode & c2
Select Case myCat
Case "作業簿_SK"
f = 3: e = 19
Case "作業簿_KK"
f = 23: e = 35
Case "作業簿_その他"
f = 39: e = 49
End Select
If f = 0 Then
MsgBox "この分類コードはサポートされていません"
Exit Sub
End If
If CLng(c2) Mod 2 = 0 Then
x = 5 'E列
Else
x = 1 'A列
End If
With Sheets("箱サンプル")
For i = 4 To 11
myMedia = Me.Controls("ComboBox" & i).Value
myQty = Me.Controls("TextBox" & i).Value
If Len(myMedia) > 0 Then
y = .Cells(e + 1, x).End(xlUp).Row + 1
If y > e Then
MsgBox myCat & "/" & myCode & "/" & myMedia & "を転記するスペースがありません"
Else
If y < f Then y = f
.Cells(y, x).Value = myCode
.Cells(y, x + 1).Value = myMedia
.Cells(y, x + 2).Value = myQty
End If
End If
Next
End With
Me.Tag = "Skip"
For Each ctrl In Me.Controls
If TypeName(ctrl) = "TextBox" Or TypeName(ctrl) = "ComboBox" Then _
ctrl.Value = vbNullString
If TypeName(ctrl) = "ComboBox" And ctrl.Name <> "ComboBox3" Then ctrl.Clear
Next
Me.Tag = Empty
End Sub
Private Sub DeleteMedia(cb As MSForms.ComboBox)
Dim i As Long
Dim dicA As Object
Dim dicB As Object
Dim d As Variant
If Me.Tag = "Skip" Then Exit Sub
Me.Tag = "Skip"
Set dicA = CreateObject("Scripting.Dictionary")
Set dicB = CreateObject("Scripting.Dictionary")
For i = 4 To 11
dicA(Me.Controls("comboBox" & i).Value) = True
Next
For Each d In dic(ComboBox3.Value)(ComboBox1.Value)
If Len(d) = 0 Or Not dicA.exists(d) Then dicB(d) = True
Next
For i = 4 To 11
With Me.Controls("ComboBox" & i)
.List = dicB.keys
End With
Next
Me.Tag = Empty
Set dicA = Nothing
Set dicB = Nothing
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Set dic = Nothing
End Sub
(ぶらっと)
★書いていて衝突しました！(ぶらっと)様、ありがとうございます。
色々とご指摘ありがとうございます。
今朝ようやく入力の元になるデータ（紙）を入手しました。 （今まで話に聞いただけで作っていたので…）
それを見て入力している人に意見を聞いたところ、
・「SK」は紙に「媒体名」＆「件数」が1枚に10項目ほど記載されていて（後から追加あり）、それを見て入力 ☆ここまでは今まで想定していたものとあまり変わりなし
・「KK」「その他」は1枚の紙に「媒体名」＆「件数」が1項目ずつ記載されていて、それが一度に15枚ほど届く。 それを見ながら入力する（これも後で追加が来ることがあり） ・枝番は一度に入力するのは同じ数字のみ（枝番1と枝番2が混在して来ることはない。枝番1が最初に届き、2以降は順次届く） ・入力する際「SK」「KK」「その他」は分けて入力して構わない ・現在はまだ無いですが、今後単価マスタに無い組合せが発生することが考えられる ・前述のように「合計」欄は件数がないものは空白になっています。この「合計」を見ながら他のブックに転記していくのですが、 間に空白があると見づらいので「合計」は上詰めで件数があるもののみ表示してほしい （A～C列、E～G列も同様に件数が無いものは上詰めで可） ※現在関数で「合計」欄を表示している便宜上「記号＆媒体名」の組合せの行は揃えていましたが、揃えなくてもいいとのこと
なので、今考えている新しいユーザーフォームは
・コンボボックス3「分類」で「SK」「KK」「その他」を選ぶ ・コンボボックス2で「枝番」を選ぶ ☆ここまで変更なし ・Bun様のご提案のように、コントロールを最大数の組合せ（仮に18組とします）で作って配置しておく ・「分類」を選んだ時点で、それに応じた「記号」「媒体名」が18組のコントロールに表示される ※コントロールの種類はラベル1～18（記号）、19～36（媒体名）にします ・それぞれに「件数」を入力するテキストボックスを配置し、件数があるもののみ入力する ・件数があるもののみ、「箱サンプル」シートのA～C列またはE～G列に転記する。「合計」欄にも転記する。 ・入力の都度、「記号＆媒体」が一致するものの件数の合計を「合計」欄に表示する
このようなものを考えています。
色々教えていただいたのに全部作り直しになってしまって申し訳ございません…
(peridot)
おおよその改訂イメージは把握できた。 まえもって、必要行数分の入力欄を設けておくことは賛成。 ただし、どうなんだろう、記号と媒体名の組合せで想定される最大値は いまは１８かもしれないけど、そのうちに増えるかもしれない。 極端に言って１００組ぐらいに？？ そうなると、入力者にとっては、組合せを探す手間が、かえって大変になるかもね。 と考えると、媒体は、コンボボックスのままにしておいてもいいのかな？とも思うけど まぁ、あらかじめ組合せを作っておくとしてラベルがいいね。
この機会に提案なんだけど、コントロールの名前をComboBox1 等のデフォルト値じゃなく cbx_分類 とか cbx_枝番 といったようにかえておくと何かといいかも。 たとえば、今の状況は、第１階層がComboBox3。だめじゃないけど、なんとなくねぇ。 これは、たまたま作成した順番にふられた番号なので、ロジック的に上、下ということを 考えると気持ちがわるいなぁ。
少なくとも、１８行を作るとすれば
lblMedia_1 lblCode_1 txtQty_1 lblMedia_2 lblCode_2 txtQty_2 lblMedia_3 lblCode_3 txtQty_3
といったようにしておくべきだね。こうせずにデフォルトのままにすると、たとえば最後の行の テキストボックスが TextBox18 だったとして、その後別のテキストボックスを作った場合 TextBox19。で、行を１行増やそうと、追加をすると 19行目が TextBox20。 これは、コード処理的にも面倒、何より、コードの可読性が格段におちる。
また、数字と文字の間に _ というセパレータを入れたけど、これは何であってもいいけど これがあるのとないのとでは、コード処理で、簡便性が大きく変わってくる。
いっそのこと、現在の価格マスタとは別に、マスタシートを準備して ・分類コードを登録 そこには 箱シート上の開始行と終了行をいれておく。 ・媒体・記号の組合せを媒体列、記号列で登録しておき、ラベルには、そこから反映させる。 （凝るなら、ここから、フォーム上のコントロールを自動生成することもできる。）
以上、いかが？
(ぶらっと)
追伸
↑で書いた「別途のマスタ」は、将来、そういう必要がでてきたら対応ということにしたほうが （peridot） さんにとって、よさそうかもね。 ただし、媒体・記号の組合せマスタは是非用意したほうがいいと思う。
↑（追記） Ａ列が分類、Ｂ列が媒体、Ｃ列が記号 といった感じで。
合計欄をマクロで生成するのはたやすいことなので、新要件対応のついでに組み込めばいい。
でも、やはり心配。組合せを１８行ほど表示した時、入力原票にあるものを、操作者が、どの行に いれるのか、探すのが、かえって手間？まぁ、そうなったら lblMedia_1 を cbxMedia_1 と、 現在のコンボボックス処理にかえればいいか・・・？
(ぶらっと)
>ただし、媒体・記号の組合せマスタは是非用意したほうがいいと思う。
此れって、単価マスタその物なのでは？
(Bun)
(ぶらっと)様 ご提案ありがとうございます。
「記号＆媒体」の組合せ自体は単価マスタにもあるのですが、「記号+枝番」「媒体」の組合せマスタがあった方がよいのであればと思い、下記の組合せマスタを作成しました。 「開始行」「終了行」「開始列」（A列からかE列からか）も記載しました
「作業分類マスタ」
A B C D E F G 1 分類 記号 枝番付記号 媒体名 開始行 終了行 開始列 2 作業簿_SK SK SK1 KZ 3 19 1 3 作業簿_SK SK SK2 KZ 3 19 5 4 作業簿_SK SK SK3 KZ 3 19 1 5 作業簿_SK SK SK4 KZ 3 19 5 ： 63 作業簿_KK VO VO1 10P 23 35 1 64 作業簿_KK VO VO2 10P 23 35 5 65 作業簿_KK VO VO3 10P 23 35 1 66 作業簿_KK VO VO4 10P 23 35 5 ： 107 作業簿_その他 Sm Sm1 N7 39 49 1 108 作業簿_その他 Sm Sm2 N7 39 49 5 109 作業簿_その他 Sm Sm3 N7 39 49 1 110 作業簿_その他 Sm Sm4 N7 39 49 5
このような感じでよろしいでしょうか…
コントロールの名前はおっしゃるように、今後増えた時のことも考えて名前を変えます。
コントロールの種類は私も悩みましたが… やはり「記号」はラベルにしておいて「媒体名」の部分はコンボボックスにしようと思います。
なので txt_Date （日付） cbx_Cls （分類） cbx_No （枝番）
記号 媒体名 件数 lblCode_1 cbxMedia_1 txtQty_1 lblCode_2 cbxMedia_2 txtQty_2 lblCode_3 cbxMedia_3 txtQty_3 ： lblCode_18 cbxMedia_18 txtQty_18
このようなレイアウトでユーザーフォームを作ってみます。
★またまた衝突しました
（Bun）様
ご指摘ありがとうございます。
(peridot)
>下記の組合せマスタを作成しました。
私は疑問だな？ 何故かと言うと、単価マスタが在って組合せマスタが有った場合 同じ事が2つの表に記載される、最初は善いけど メンテナンスが何時まで出来のか こう言うのは使っている内にどちらかの表の記載を忘れる、間違えるが出る様な気がします 最終的に「どちらの表がほんとなの？」ってころに成る様な気がします？
(Bun)
Bun様 ありがとうございます。 ご指摘ご尤もです。
現在の「単価マスタ」のレイアウトは下記の通りですが、開始行・最終行があった方が都合がよいのであれば、K列以降に追加します。
★シート"単価マスタ" A B C D E F G H I J 1 単価表 2 記号 媒体名 基本単価 追加分 付帯業務 区分 基本コスト 単価 分類 3 SK KZ 19 1 1.2 1.5 22.7 17.0 作業簿_SK 4 SK MZ 19 1 1.2 1.5 22.7 17.0 作業簿_SK 5 SK HY 19 2 0 1.5 22.5 16.9 作業簿_SK 6 SK FR 19 0 0 1.5 20.5 15.4 作業簿_SK 7 VA KK 19 2 1.2 1.5 23.7 17.8 作業簿_KK 8 VE KK 19 0 0 1.5 20.5 15.4 作業簿_KK 9 VS 10P 19 0 12.2 1.5 32.7 24.5 作業簿_その他
枝番はユーザーフォームのコンボボックス cbx_No でその都度追加という形でも大丈夫でしょうか。
(peridot)
>此れって、単価マスタその物なのでは？
別にこだわるわけじゃないけど、単価マスタにない組合せもありうるというコメントをちらっと見たような気がしたので。 まぁ、そのときは、必ず単価マスタに登録されるんだろうけど。
>開始行・最終行があった方が都合がよいのであれば、K列以降に追加します
すくなくとも、今は必須ではないね。 箱サンプルシートのレイアウトが、固定になっているのがちょっと気になって。 分類が増えるとか、各分類におさめるデータ行数がかわるとか、そういった時に便利かなと。
で、この登録をするとすれば、分類コードだけのマスタを作ってそこでやるべきだね。 同じFrom/To をいくつもの行に書くのは、うまくないので。
★いいだしっぺなのに、申し訳ないけど、当面は、現在の単価マスタだけの形で進めて、将来、いろんなことで 必要になれば、改訂していくことにしたらどうだろう？
(ぶらっと)
今、あらためて前トピも読み直していたら、媒体、記号で行をそろえなきゃいけない要件があったんだね。 アップしたものにはいれていないので、そこも組み込むとして。
媒体をコンボボックスの構えにしたということは、例の選ばれたら、それをリストから削除していく要件も 継続されると言うことだね。前は、フォーム上に記号は１つしかなかったんだけど、今回は、複数の記号が 存在する可能性があるんだよね。なので選ばれた媒体をリストから削除する場合、｢同じ記号｣のコンボボックスだけが 削除対象だね。ひゃぁ、けっこうめんどいかもね。
それと、フォーム上の１８行なんだけど、最初にこちらで想定していたのは、 ・選ばれた分類に許された記号・媒体の行数だけを表示にして、あとは非表示。 ・で、その表示された行の記号や媒体のキャプションはマスタ（単価表）から自動セット。 このように考えていた。
だけど、媒体はコンボボックスで残すとなると・・・
たとえば実際には単価表の行数はもっと多いんだろうけど、アップされた例でいうと 作業簿_SK が選ばれたら、フォームには、何行、どのような記号が表示される予定かな？ SK が ４行？ 作業簿_KK が選ばれたら VA が１行、VE が １行？
追記） 媒体をコンボボックスで残す、その意図（目的）は何だろうか？
(ぶらっと)
私成りの理解で作って見ました？ 以下を用意して下さい 1、AdvancedFilterを使って単価表から絞り込み抽出を行う為、「抽出」と言う名前を付けたシートを用意します シートには、抽出範囲としてA1：「分類」、B1：「記号」、C1：「媒体名」と言う列見出し 条件範囲としてF1：「分類」、G1：「記号」と言う列見出しを其々「単価マスタ」からCopyして下さい
A B C D E F G 1 分類 記号 媒体名 分類 記号
※運用時に非表示にしても可
2、UserFormを用意します、配置するコントロールは名はCommandButtonを除き頭にプリフィックスを付け ComboBox、TextBoxの区別を付けます（ComboBox：cbx、TextBox：txt） txtDate：日付用 cbxClass：分類用
cbxCode1 cbxNum1 cbxMedia1 txtQtyC1 txtCode1 txtMedia1 txtQtyG1 txtCodeJ1 txtMediaK1 txtQtyL1 cbxCode2 cbxNum2 cbxMedia2 txtQtyC2 txtCode2 txtMedia2 txtQtyG2 txtCodeJ2 txtMediaK2 txtQtyL2 ・ ・ cbxCode17 cbxNum17 cbxMedia17 txtQtyC17 txtCode17 txtMedia17 txtQtyG17 txtCodeJ17 txtMediaK17 txtQtyL17 cbxCode18 cbxNum18 cbxMedia18 txtQtyC18 txtCode18 txtMedia18 txtQtyG18 txtCodeJ18 txtMediaK18 txtQtyL18
CommandButton1：入力更新用、CommandButton2：閉じる用
※各列は、「箱サンプル」シートのA、B、C E、F、G J、K、Lに対応します（但しcbxCodeとcbxNumでA列） 次に、手入力を行わないコントロールのtxtQtyC1～18、txtCode1～18、txtCodeJ1～18、txtMediaK1～18、txtQtyL1～18に就いては、以下のプロパティを設定して下さい Locked = True、TabStop = False（後BackColorも変えた方が解りやすいかな？） 選択したいコントロールが架かる様にドラッグすれば、複数のコントロールが一遍にプロパティの変更が出来ます
3、以下にUserFormのコードを載せます
Option Explicit
Private Const clngExtr As Long = 3 '抽出列数
Private wksMark As Worksheet '入力先のシート Private rngList As Range '単価マスタのデータ範囲 Private rngWork As Range '作業用シートの抽出範囲 Private rngCrit As Range '作業用シートの条件範囲先頭セル位置 Private lngRow As Long '抽出行数（最終行位置） Private rngAdd As Range '入力範囲先頭位置
Private Sub UserForm_Initialize()
Dim i As Long
Dim vntData As Variant
Dim lngRows As Long
'入力先のシートを指定
Set wksMark = Worksheets("箱サンプル")
'単価マスタ先頭セル位置を指定
Set rngList = Worksheets("単価マスタ").Range("B2")
'作業用シートの抽出範囲を指定
Set rngWork = Worksheets("抽出").Range("A1")
'作業用シートの条件範囲先頭セル位置を指定
Set rngCrit = rngWork.Parent.Range("F1")
'Listの行数、列数取得
With rngList
'B列で行数の取得
lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
End With
'単価マスタのデータ範囲の再設定
Set rngList = rngList.Resize(lngRows + 1, 9)
'ComboBox1に「分類」を設定（各分類の先頭位置とデータ行数も其々別の列に設定）
With cbxClass
For i = 0 To 2
.AddItem Choose(i + 1, "作業簿_SK", "作業簿_KK", "作業簿_その他")
.List(i, 1) = Choose(i + 1, 2, 22, 38)
.List(i, 2) = Choose(i + 1, 18, 14, 11)
Next i
End With
'枝番の番号設定
For i = 1 To 18
Controls("cbxNum" & i).List = Array("1", "3")
Next i
'日付の読み込み
txtDate.Text = wksMark.Cells(1, "F").Value
If txtDate.Text = "" Then
txtDate.Text = Date
End If
End Sub
Private Sub UserForm_Terminate()
'日付の書き込み
wksMark.Cells(1, "F").Value = txtDate
Set rngList = Nothing
Set rngWork = Nothing
Set rngCrit = Nothing
Set wksMark = Nothing
Set rngAdd = Nothing
End Sub
Private Sub cbxClass_Change()
Dim i As Long
Dim vntData As Variant
Dim vntRows As Variant
If cbxClass.ListIndex = -1 Then
Exit Sub
End If
'「記号」のデータを取得
vntData = GetComboList(cbxClass.Text, 1)
For i = 1 To 18
With Controls("cbxCode" & i)
'抽出行数が0で無いなら
If lngRow > 0 Then
'ComboBox2にListを設定
.List = vntData
Else
'ComboBox2をクリア
.Clear
End If
End With
Next i
'出力範囲のデータを取得
With cbxClass
vntData = .List(.ListIndex, 1)
vntRows = .List(.ListIndex, 2)
End With
'出力範囲先頭を設定
Set rngAdd = wksMark.Cells(vntData, "A")
'入力用コントロールの入力範囲分を表示にし、データを読み込み
For i = 1 To vntRows
ControlsVisible i, True
GetLineData i, rngAdd
Next i
'入力用コントロールの入力範囲範囲外を非表示に
For i = vntRows + 1 To 18
ControlsVisible i, False
Next i
End Sub
Private Sub cbxClass_Enter()
Dim i As Long
cbxCode1.ListIndex = -1
For i = 1 To 18
Controls("cbxCode" & i).ListIndex = -1
Controls("cbxNum" & i).ListIndex = -1
With Controls("cbxMedia" & i)
.ListIndex = -1
.Clear
End With
Next i
End Sub
Private Sub CommandButton1_Click()
Dim i As Long
Dim vntRows As Variant
With cbxClass
If .ListIndex = -1 Then
Exit Sub
End If
vntRows = .List(.ListIndex, 2)
End With
If MsgBox("データの更新をします！！", vbInformation + vbOKCancel) = vbCancel Then
Exit Sub
End If
'データの書き込み
For i = 1 To vntRows
PutLineData i, rngAdd
Next i
End Sub
Private Sub CommandButton2_Click()
Unload Me
End Sub
Private Sub ChangeSymbol(lngNumb As Long)
Dim vntData As Variant
'J列の値を代入
If Controls("cbxCode" & lngNumb).ListIndex > -1 Then
Controls("txtCodeJ" & lngNumb).Text = Controls("cbxCode" & lngNumb).Text
Else
Controls("txtCodeJ" & lngNumb).Text = Empty
End If
If Controls("cbxCode" & lngNumb).ListIndex = -1 Then
Exit Sub
End If
'「媒体名」のデータを取得
vntData = GetComboList(Controls("cbxCode" & lngNumb).Text, 2)
With Controls("cbxMedia" & lngNumb)
'抽出行数が0で無いなら
If lngRow > 0 Then
'ComboBoxにListを設定
.List = vntData
Else
'ComboBoxをクリア
.Clear
End If
End With
End Sub
Private Sub ChangeNumbBox(lngNumb As Long)
If Val(Controls("txtQtyG" & lngNumb).Text) > 0 Then
Controls("txtCode" & lngNumb).Text _
= Controls("cbxCode" & lngNumb).Text & (Val(Controls("cbxNum" & lngNumb).Text) + 1)
Controls("txtMedia" & lngNumb).Text = Controls("cbxMedia" & lngNumb).Text
Else
Controls("txtCode" & lngNumb).Text = ""
Controls("txtMedia" & lngNumb).Text = ""
End If
NumbBoxSum lngNumb
End Sub
Private Sub ChangeMedium(lngNumb As Long)
Controls("txtMediaK" & lngNumb).Text = Controls("cbxMedia" & lngNumb).Text
End Sub
Private Sub SubNumb(lngNumb As Long)
If Controls("cbxNum" & lngNumb).Text = "3" Then
Controls("txtQtyG" & lngNumb).Enabled = False
Else
Controls("txtQtyG" & lngNumb).Enabled = True
End If
End Sub
Private Sub NumbBoxSum(lngNumb As Long)
Dim vntData As Variant
vntData = Val(Controls("txtQtyC" & lngNumb).Text) + Val(Controls("txtQtyG" & lngNumb).Text)
If vntData = 0 Then
vntData = Empty
End If
Controls("txtQtyL" & lngNumb).Text = vntData
End Sub
Private Sub GetLineData(lngNumb As Long, rngTop As Range)
Dim vntData As Variant
Dim vntTmp As Variant
vntData = rngTop.Offset(lngNumb).Resize(, 12).Value
'A列がEmpty値で無いなら
If Not IsEmpty(vntData(1, 1)) Then 'A列
vntTmp = vntData(1, 1)
'E列がEmpty値で無いなら
ElseIf Not IsEmpty(vntData(1, 5)) Then
vntTmp = vntData(1, 5)
End If
If Not IsEmpty(vntTmp) Then
Controls("cbxCode" & lngNumb).Text = Left(vntTmp, Len(vntTmp) - 1)
vntTmp = Val(Right(vntTmp, 1))
If vntTmp Mod 2 = 0 Then
vntTmp = vntTmp - 1
End If
Controls("cbxNum" & lngNumb).Text = CStr(vntTmp)
Else
Controls("cbxCode" & lngNumb).Text = ""
Controls("cbxNum" & lngNumb).ListIndex = -1
End If
If Not IsEmpty(vntData(1, 2)) Then 'B列
vntTmp = vntData(1, 2)
ElseIf Not IsEmpty(vntData(1, 6)) Then
vntTmp = vntData(1, 6)
End If
Controls("cbxMedia" & lngNumb).Text = vntTmp
Controls("txtQtyC" & lngNumb).Text = vntData(1, 3) 'C列
Controls("txtCode" & lngNumb).Text = vntData(1, 5) 'E列
Controls("txtMedia" & lngNumb).Text = vntData(1, 6) 'F列
Controls("txtQtyG" & lngNumb).Text = vntData(1, 7) 'G列
End Sub
Private Sub PutLineData(lngNumb As Long, rngTop As Range)
Dim vntData As Variant
ReDim vntData(1 To 12)
'C列の値が有ったなら
If Val(Controls("txtQtyC" & lngNumb).Text) > 0 Then
vntData(1) = Controls("cbxCode" & lngNumb).Text _
& Controls("cbxNum" & lngNumb).Text 'A列
vntData(2) = Controls("cbxMedia" & lngNumb).Text 'B列
vntData(3) = Controls("txtQtyC" & lngNumb).Text 'C列
End If
'G列の値が有ったなら
If Val(Controls("txtQtyG" & lngNumb).Text) > 0 Then
vntData(5) = Controls("txtCode" & lngNumb).Text 'E列
vntData(6) = Controls("txtMedia" & lngNumb).Text 'F列
vntData(7) = Controls("txtQtyG" & lngNumb).Text 'G列
End If
vntData(10) = Controls("txtCodeJ" & lngNumb).Text 'J列
vntData(11) = Controls("txtMediaK" & lngNumb).Text 'K列
vntData(12) = Controls("txtQtyL" & lngNumb).Text 'J列
rngTop.Offset(lngNumb).Resize(, 12).Value = vntData
End Sub
Private Sub ControlsVisible(lngNumb As Long, blnVisible As Boolean)
Controls("cbxCode" & lngNumb).Visible = blnVisible 'A列
Controls("cbxNum" & lngNumb).Visible = blnVisible
Controls("cbxMedia" & lngNumb).Visible = blnVisible 'B列
Controls("txtQtyC" & lngNumb).Visible = blnVisible 'C列
Controls("txtCode" & lngNumb).Visible = blnVisible 'E列
Controls("txtMedia" & lngNumb).Visible = blnVisible 'F列
Controls("txtQtyG" & lngNumb).Visible = blnVisible 'G列
Controls("txtCodeJ" & lngNumb).Visible = blnVisible 'J列
Controls("txtMediaK" & lngNumb).Visible = blnVisible 'K列
Controls("txtQtyL" & lngNumb).Visible = blnVisible 'J列
End Sub
Private Function GetComboList(vntCrit As Variant, lngNum As Long) As Variant
Dim vntData As Variant
'条件範囲にComboBoxの値を代入（式の形で）
rngCrit.Offset(1, lngNum - 1).Value = "=""" & vntCrit & """"
'AdvancedFilterを実行
DoFilter rngList, rngCrit.Resize(2, lngNum), rngWork.Resize(, clngExtr)
'抽出範囲から
With rngWork
'抽出行数を取得
lngRow = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
'列見出し以上の行が在るなら
If lngRow > 0 Then
'指定列からデータを配列に取得
vntData = .Offset(1, lngNum).Resize(lngRow, 2).Value
ReDim Preserve vntData(1 To lngRow, 1 To 1)
GetComboList = Unique(vntData)
End If
End With
End Function
Private Sub DoFilter(rngScope As Range, _
rngCriteria As Range, _
rngCopyTo As Range, _
Optional blnUnique As Boolean)
' AdvancedFilterを実行
rngScope.AdvancedFilter _
Action:=xlFilterCopy, _
CriteriaRange:=rngCriteria, _
CopyToRange:=rngCopyTo, _
Unique:=blnUnique
End Sub
Private Function Unique(vntData As Variant) As Variant
' 値の重複取り
Dim i As Long
Dim j As Long
Dim lngEnd As Long
Dim vntList As Variant
ReDim vntList(1 To UBound(vntData, 1))
'値の重複取り
For i = 1 To UBound(vntData, 1)
For j = 1 To lngEnd
If vntData(i, 1) = vntList(j) Then
Exit For
End If
Next j
If j > lngEnd Then
If Not IsEmpty(vntData(i, 1)) Then
lngEnd = j
vntList(lngEnd) = vntData(i, 1)
End If
End If
Next i
ReDim Preserve vntList(1 To lngEnd)
'戻り値として重複無しの値を返す
Unique = vntList
End Function
’以下のコードは省略が有ります（各プロシージャは1～18迄有りますので間を埋めて下さい）
Private Sub cbxCode1_Change()
ChangeSymbol 1
End Sub
Private Sub cbxCode2_Change()
ChangeSymbol 2
End Sub
・
・
Private Sub cbxCode18_Change()
ChangeSymbol 18
End Sub
Private Sub cbxNum1_Change()
SubNumb 1
End Sub
Private Sub cbxNum2_Change()
SubNumb 2
End Sub
・
・
Private Sub cbxNum18_Change()
SubNumb 18
End Sub
Private Sub cbxMedia1_Change()
ChangeMedium 1
End Sub
Private Sub cbxMedia2_Change()
ChangeMedium 2
End Sub
・
・
Private Sub cbxMedia18_Change()
ChangeMedium 18
End Sub
Private Sub txtQtyC1_Change()
NumbBoxSum 1
End Sub
Private Sub txtQtyC2_Change()
NumbBoxSum 2
End Sub
・
・
Private Sub txtQtyC18_Change()
NumbBoxSum 18
End Sub
Private Sub txtQtyG1_Change()
ChangeNumbBox 1
End Sub
Private Sub txtQtyG2_Change()
ChangeNumbBox 2
End Sub
・
・
Private Sub txtQtyG18_Change()
ChangeNumbBox 18
End Sub
(Bun)
単一の機能要件のサンプルではなく、結構、こみいった、この要件に対して２つの異なるコードがあっても(peridot)さんが混乱するだけだろうから 個人的には、取り組んでいきたいテーマだけど、私は撤退します。
(ぶらっと)
入力時に、 記号入力用cbxCode1からcbxClassに戻した時にcbxCode1の値がクリアされる不都合が在る為 下記のプロシージャを削除して下さい
Private Sub cbxClass_Enter() '★削除
Dim i As Long '★削除
cbxCode1.ListIndex = -1 '★削除
For i = 1 To 18 '★削除
Controls("cbxCode" & i).ListIndex = -1 '★削除
Controls("cbxNum" & i).ListIndex = -1 '★削除
With Controls("cbxMedia" & i) '★削除
.ListIndex = -1 '★削除
.Clear '★削除
End With '★削除
Next i '★削除
End Sub '★削除
(Bun)
>（ぶらっと）様
> 今、あらためて前トピも読み直していたら、媒体、記号で行をそろえなきゃいけない要件があったんだね。 現在「合計」を関数で出している関係上そのようになっていますが、マクロで合計まで出せるのであれば 揃えなくてもいいとのことです。
> たとえば実際には単価表の行数はもっと多いんだろうけど、アップされた例でいうと > 作業簿_SK が選ばれたら、フォームには、何行、どのような記号が表示される予定かな？ ラベル（記号）には単価マスタにある記号が全て表示され（SKは現在全部で17個あるのでlblCode17まで「SK」を表示） 媒体名をコンボボックスで選択していくようにしたいと思っています。
> 追記） 媒体をコンボボックスで残す、その意図（目的）は何だろうか？ 一番入力の多い「SK」が「記号」が統一、「媒体名」は17種で、前におっしゃられたように
>組合せを１８行ほど表示した時、入力原票にあるものを、操作者が、どの行に >いれるのか、探すのが、かえって手間？ これにできるだけ対応しようと思ったからです。
>（Bun）様
cbxCode1 cbxNum1 cbxMedia1 txtQtyC1 txtCode1 txtMedia1 txtQtyG1 txtCodeJ1 txtMediaK1 txtQtyL1 cbxCode2 cbxNum2 cbxMedia2 txtQtyC2 txtCode2 txtMedia2 txtQtyG2 txtCodeJ2 txtMediaK2 txtQtyL2 ・ ・ cbxCode17 cbxNum17 cbxMedia17 txtQtyC17 txtCode17 txtMedia17 txtQtyG17 txtCodeJ17 txtMediaK17 txtQtyL17 cbxCode18 cbxNum18 cbxMedia18 txtQtyC18 txtCode18 txtMedia18 txtQtyG18 txtCodeJ18 txtMediaK18 txtQtyL18
これは各コントロールを18個ずつ、合計180個用意するということですか？ それはさすがにユーザーフォームがものすごいことになるかと思うのですが… あまりにも項目が多すぎると入力者が混乱しかねないので…
私が考えた txt_Date （日付） cbx_Cls （分類） cbx_No （枝番）
記号 媒体名 件数 lblCode_1 cbxMedia_1 txtQty_1 lblCode_2 cbxMedia_2 txtQty_2 lblCode_3 cbxMedia_3 txtQty_3 ： lblCode_18 cbxMedia_18 txtQty_18
このレイアウトでは不都合でしょうか？ 今の「記号」「媒体」「件数」が合計54個ある状態でもユーザーフォームはいっぱいいっぱいです…
(peridot)
コンボボックスを残す意図（理由）は了解。同意。 で、分類が選択されたら、フォーム上の行は、単価マスタにある「その分類に紐つく記号」の行数だけ その記号をラベルのキャプションに反映させて表示するという意味だね、これも、クリアに了解。
ただ、この種の、いくつかの機能要件が組み合わされた、一連のストーリーとしてのコードということを 考えると、私のコード、BUnさんのコードと、全く異なるコードが、並行してアップされていっても (peridot) さんが混乱するかなと。 なので、Bunさんにお任せして、私は撤退しようと、そう書いた。
これが、単体の、ある処理機能だけに対する、コード案の質問なら、様々な回答者さんからの、それぞれのコードが 質問者さんにとっては、有意義になるんだけどね。
もし、(peridot) さんが、「混乱しない、並行してアップされていくだろう、両者のコード双方を、それぞれ確認していける」 ということなら、引き続き参加するけど？
(ぶらっと)
(ぶらっと)様ありがとうございます。
私も操作性を確認しながら進めたいので、引き続きご指導いただければありがたいのですが…
長くなりましたので次のトピを立てました。
よろしくお願いいたします。
(peridot)
>これは各コントロールを18個ずつ、合計180個用意するということですか？ >それはさすがにユーザーフォームがものすごいことになるかと思うのですが… >あまりにも項目が多すぎると入力者が混乱しかねないので…
そうだよ？ 確かにUserFormは大きく成るけど、さしてビックリするほどでは無いと個人的には思いますよ？ このコントロールの配置は「作業簿_SK」の入力範囲全てを網羅している筈です 実際の転記するシートのイメージに近い表示にする為、コントロールが少し多く成っても、この様な配置にしています
ただ、実際に入力する項目自体は、1行、cbxCode、cbxNum、cbxMedia、txtQtyC、txtQtyGの5項目だけです 後の、txtCode、txtMedia、txtCodeJ、xtMediaK、txtQtyLはシートに転記されるデータの表示域なので 混乱するほどでは無いと思いますが？ 実際の入力項目以外のコントロールはUpした時に書いた様に視覚的には色分け、コントロールとしては 入力不可の設定を行います
UserFormを起動して、「分類」を選択すれば選択された分類の入力範囲が全てUserFormに読み込まれます この時新規の入力なら、コントロールは全て空白、既に入力済みの部分が在れば其れが読み込まれます 此れで、新規入力、入力修正を行ってボタンを押せば、表示項目がシートに転記されます 入力に際し、「記号」を選択→「枝番」を選択→「媒体名」を選択→C列の「件数」を入力 （この時件数を入力しなければA、B、C列の値は転記されません）→G列の件数を入力（この時、 txtQtyGに入力が在ればtxtCode、txtMediaに転記項目が表示されます、入力が無ければ表示されません） また、txtQtyC、txtQtyGに入力が在れば、txtCodeJ、xtMediaK、txtQtyLに横計が表示されます
多分、UserFromを作るのは少々時間が掛かるかも解りませんが、実際にシートに入力しているイメージで 入力出来る様にと考えるとこの様な配置成りました
(Bun)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.