[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『入荷データ入力時の枝番生成』（雪だるま）
いつもお世話になっております。 Excel2007です。
[[20111226175037]][[20111205105217]]
などでお世話になりました。
商品の入荷マスタファイルがあり、入荷予定を入力後、実際に入荷した際に詳細データを登録しています。
データシートのレイアウト
A B C D E ～ I J ～ O P Q R S ～ AC AD AE AF ～ 1 番号 荷受No(1) 荷受No(2) 枝番 入荷受付番号 ～ 伝票番号 納品日 ～在庫ID 品名 入荷予定数 入荷実数 在庫数 ～ 使用期限（年）（月）（日） 記号 ～
横に長いのですがこのようなレイアウトです。
先に入荷予定の商品の情報（入荷予定日予定数など）を入力します。 ところが実際に入荷した商品の使用期限がバラバラのものがあると、元のデータに枝番をつけて行を増やして 使用期限・記号（ロットのようなもの）ごとに分けて入力します。
(例)
★入荷予定入力時 A B C D E ～ O P Q R S ～ AC AD AE AF ～ 1 番号 荷受No(1) 荷受No(2) 枝番 入荷受付番号 ～ 在庫ID 品名 入荷予定数 入荷実数 在庫数 ～ 使用期限（年）（月）（日） 記号 ～ （2～3行目見出し行） ： 10 7 120111 0001 00 120111000100 ～ ST1001 サンプルA 1000 11 8 120111 0002 00 120111000200 ～ ZZ1001 サンプルB 2000
↓「サンプルA」の使用期限が複数あった時
A B C D E ～ O P Q R S ～ AC AD AE AF ～ 1 番号 荷受No(1) 荷受No(2) 枝番 入荷受付番号 ～ 在庫ID 品名 入荷予定数 入荷実数 在庫数 ～ 使用期限（年）（月）（日） 記号 ～ （2～3行目見出し行） ： 10 7 120111 0001 00 120111000100 ～ ST1001 サンプルA 1000 500 500 ～ 2012 10 31 X 11 8 120111 0001 01 120111000101 ～ ST1001 サンプルA * 200 200 ～ 2012 11 20 Y 12 9 120111 0001 02 120111000102 ～ ST1001 サンプルA * 300 200 ～ 2012 12 25 Z 13 10 120111 0002 00 120111000200 ～ ZZ1001 サンプルB 2000
上記のように元からあったデータ行の間に枝番の行を挿入し、数量や使用期限などを分けて記入します。
A列には連番をふるためのROW関数が入っており、E列はB～D列を&で結合した式が入っています。 またB～D列は文字列型です。
この枝番を作成して元からあるデータを下にずらしていく作業が、多い時には何十行もずらすことがあり結構大変です。 どの使用期限でどれくらい入ってくるというのは入荷当日にならないと分かりません。
入荷実績を入力する際に、ユーザーフォームで最初のデータ（予定時に入力されたデータ）を呼び出し（E列をキーに呼び出し）、 その行をコピーして挿入、枝番をふって使用期限などを記入していく…といったことができれば便利なのですが、 列を指定の行にコピー・挿入し、その挿入したデータを表示する、までの手順が分かりません。
コピーした列を挿入する方法をマクロの記録で試したところ
Sub test() ' ' test Macro '
'
ActiveWindow.SmallScroll Down:=-75
Rows("10:10").Select
Selection.Copy
Rows("11:11").Select
Selection.Insert Shift:=xlDown
End Sub
このようになりました。 これを応用してできないかと試行錯誤していますが、追加したデータが参照できなかったり 違うところに行が挿入されたりうまくいきません。
お手数ですがアドバイスをお願いします。
過去のスレはよくみていないし、今回の質問も、まだよく読んでいないんだけど
>コピーした列を挿入する方法をマクロの記録で試したところ
これは、「コピーした行を」だとして、
>追加したデータが参照できなかったり違うところに行が挿入されたりうまくいきません。
これは、具体的にどういうところで困ってるのかな？ 10とか11が固定になっているので具合が悪い、ここを変数にしたいということ？
(ぶらっと)
此方も尻に火が付いて居て、まともな解答が出来ないで申し訳在りませんが？ （雪だるま）さんとして、UserFormに呼び出したデータをListに出力する事は、出来ますか？ 出来るなら、幾つか問題点も在ると思いますが？ 簡単な手順として
1、A列の番号がRow関数で入っていると言う事なので、先ずマクロの最初で此れを値に置き換えます 2、UserFormに呼び出したデータを変更して（枝番等）A列の番号を呼び出したレコードと同じにして 例えば、入荷受付番号(120111000100)のA列のIDが7なら、新規の作るレコードのA列IDも7にして 入荷マスタの最後に追加します、 3、此れを繰り返して、枝番号となるレコードを全てListの最後に追加します 4、追加が終わったら、入荷マスタ全体をA列番号で昇順整列します Excelの整列は安定な整列を行う為、後に追加したレコードは元番号（枝番00）の下に並びます 5、整列が終わったなら、値にして有ったA列のIDを関数に置き換えます(Row関数をA列に代入)
以上此れをマクロで行えば、善いと思いますが？
(Bun)
>これは、「コピーした行を」だとして、 すみません、その通りです。
あと上に「E列をキーに呼び出し」と書いたのですが、ユーザーフォームの３つのテキストボックスにB～D列の内容を入力してデータ呼び出し
→まずこの呼び出しの方法がよくわからず、行き詰ったので、コピーした行の挿入だけをテストしたのですが おっしゃるように自分が挿入したい行を指定するための変数に値が格納できません。 （変数をどう指定すればよいかわからない）
これで教えていただいたものの関連です。
呼び出したデータは入荷時に修正があるため、全てテキストボックス・コンボボックス・オプションボタンに表示するようにしようとしています。
テキストボックスは15個、コンボボックス7個、オプションボタン2個（2個で1グループ）あります。 「行追加」というコマンドボタンで指定した行をコピー・挿入しようとしていますが上記のような内容でできません…
★書いていて衝突しました
>Bun様
ありがとうございます。 レコード全体を並び変えるとなると、以前別件で試したのですが1件並び変えるのに5分ほどExcelが固まってしまいました… 恐らくE列に結合式が入っていたり、今回のデータでは扱わない別の部分にVLOOKUP関数が入っていたりするためかもしれません。 リストボックスに表示するまではできると思いますが、追加で書きましたようにE列の「入荷受付番号」ではなく B～D列の値をテキストボックス3個に入れた時点で呼び出しをしたいと思います。 （枝番生成のためにどちらにしろこれらのテキストボックスが必要なので）
（雪だるま）
とりあえずサンプルとして、Ｂ，Ｃ，Ｄ，Ｅ列を対象にしたコード。 対象の元データはコンボボックスなどで選ばず、シートの当該行の任意のセル（行全体でもいいけど）を選ぶ方式にした。 （本来ならユーザーフォームのコントロールのRefEditを使うべきだろうけどバグが多いのでInputBoxで）
TestBox1,2,3,4 がＢ，Ｃ，Ｄ，Ｅ列のデータ。 CommandButton1 がデータ選択。CommandButton2で選択して必要なら変更した値をデータシートに書き戻す。 Label1 元データのＥ列を表示。
Option Explicit
Dim orgRow As Long
Private Sub UserForm_Initialize()
Label1.Caption = Empty
End Sub
Private Sub CommandButton1_Click()
'挿入元の選択
Dim r As Range
Dim seq As Long
On Error Resume Next
Set r = Application.InputBox("元データを選んでください", "枝番データ挿入先指定", Type:=8)
On Error GoTo 0
If r Is Nothing Then Exit Sub
orgRow = r.Row
seq = Val(r.EntireRow.Range("D1").Value) + 1
Label1.Caption = r.EntireRow.Range("E1").Value '入荷受付番号
TextBox1.Value = r.EntireRow.Range("B1").Value '荷受１
TextBox2.Value = r.EntireRow.Range("C1").Value '荷受２
TextBox3.Value = Format(seq, "00") '新枝番
TextBox4.Value = TextBox1.Value & TextBox2.Value & TextBox3.Value '新入荷受付番号
End Sub
Private Sub CommandButton2_Click()
'データシート反映
If orgRow = 0 Then
MsgBox "元データが選択されていません"
Exit Sub
End If
Rows(orgRow + 1).Insert Shift:=xlDown
With Rows(orgRow + 1)
.Range("A1").Formula = "=ROW()"
.Range("B1").Value = TextBox1.Value
.Range("C1").Value = TextBox2.Value
.Range("D1").Value = TextBox3.Value
.Range("E1").Value = TextBox4.Value
End With
orgRow = 0
TextBox1.Value = Empty
TextBox2.Value = Empty
TextBox3.Value = Empty
TextBox4.Value = Empty
Label1.Caption = Empty
End Sub
(ぶらっと)
ぶらっと様 ありがとうございます。
>対象の元データはコンボボックスなどで選ばず、シートの当該行の任意のセル（行全体でもいいけど）を選ぶ方式にした。
これは今試したのですが、InputBoxを表示した状態でマウスで該当のセルまたは行を選択するということでしょうか。 InputBoxに入荷受付番号などを入力しても「入力された参照が正しくありません」というエラーが出ます。
データシートが大きいため画面の縮尺率がかなり小さくなっており、元データの目視での検索が大変なので荷受Noなどで検索しようとしていたのですが…
今から他のデータをテキストボックスなどに表示されるようにコードを書いてみます。
（雪だるま）
>これは今試したのですが、InputBoxを表示した状態でマウスで該当のセルまたは行を選択するということでしょうか。
はい、そうです。 コンボボックスがいいなら、そうしてもいいけど、それでも、たくさんの行数のリストから選ぶことになるよ。 まぁ、MatchEntryプロパティを適切なものにして、先頭何文字か打ち込んだら、その文字列から始まるものが コンボボックスに自動的に表示されるということで、少しはいいかもしれないけどね。
(ぶらっと)
すみません、完全に私の説明不足でした。
このユーザーフォームは「枝番生成」が前提ではなく、
① 入荷予定入力されたデータに、実際に入荷した時に数量などの詳細データを入力したい。 ② ①の過程で「場合によっては」枝番生成の必要が出てくるので、その場合は元の行をコピーして枝番をつけたデータを追加したい。
という目的で作っています。
最初に枝番云々書いてしまったために行挿入が前提になってしまいましたが、入荷データによっては枝番が必要ない （行を挿入する必要がない）ものも多数あります。 なので、
・入荷受付番号またはB～D列の値を入れることで元のデータをユーザーフォームに表示し ↓ ・実際に入荷した数などを入力 ↓ ・必要があれば「行挿入」などで枝番のついたデータを追加
という流れになります。
説明が悪くてすみませんでした
（雪だるま）
といううことは、あるときは挿入、あるときは、選択したものを上書き、あるときは削除なんてことがあるわけだね？ ということだと、実行ボタンは３種類かな？
コンボボックスからのデータ選択とあわせて、ちょっと書いてみる。
(ぶらっと)
削除はありませんが（入荷しなかったものは入荷数に「キャンセル」の文字が入る）上書きはあります。 すみませんでした
（雪だるま）
↑を読む前に書いたので削除も入ってるけど。 Label1は従来どおり表示用 CommandButton1は実行（更新）用。CommandButton2は使わない。 ComboBox1を追加。ここで選んで、エンター、タブ 等でデータ抽出。 OptionButton1,2,3,4を追加。（新規、修正、削除、挿入） TextBoxは1,2,3がＢ，Ｃ，Ｅ列用。（TextBox4は使わない） なお、Ｄ列の枝番はOptionButtonの選ばれ方により自動的に生成。
Option Explicit
Dim orgRow As Long Dim skip As Boolean
Private Sub UserForm_Initialize()
Dim z As Long
Dim i As Long
Dim v() As String
Label1.Caption = Empty
With ComboBox1
.MatchRequired = True
.MatchEntry = fmMatchEntryComplete
End With
z = Range("E" & Rows.Count).End(xlUp).Row
ReDim v(4 To z)
For i = 4 To z
v(i) = Cells(i, "E").Value
Next
ComboBox1.List = v
OptionButton1.Caption = "新規"
OptionButton2.Caption = "修正"
OptionButton3.Caption = "削除"
OptionButton4.Caption = "枝番挿入"
OptionButton1.Value = True '初期値 実際に初期値にふさわしいものに適宜変更
End Sub
Private Sub ComboBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
'挿入元の選択
Dim r As Range
If skip Then Exit Sub
orgRow = ComboBox1.ListIndex + 4
Label1.Caption = Cells(orgRow, "E").Value '入荷受付番号
TextBox1.Value = Cells(orgRow, "B").Value '荷受１
TextBox2.Value = Cells(orgRow, "C").Value '荷受２
TextBox3.Value = TextBox1.Value & TextBox2.Value & TextBox3.Value '新入荷受付番号
End Sub
Private Sub CommandButton1_Click()
'データシート反映
Dim seq As Long
Dim myRow As Long
If ComboBox1.ListIndex < 0 Then
MsgBox "元データが選択されていません"
Exit Sub
End If
If OptionButton3 Then '削除
Rows(orgRow).Delete
Else
If OptionButton1.Value Then '新規
seq = 0
myRow = Range("E" & Rows.Count).End(xlUp).Row + 1
ElseIf OptionButton2 Then '修正
seq = Val(Cells(orgRow, "D").Value)
myRow = orgRow
Else '挿入
seq = Val(Cells(orgRow, "D").Value) + 1
Rows(orgRow + 1).Insert Shift:=xlDown
myRow = orgRow + 1
End If
With Rows(myRow)
.Range("A1").Formula = "=ROW()"
.Range("B1").Value = TextBox1.Value
.Range("C1").Value = TextBox2.Value
.Range("D1").Value = Format(seq, "00")
.Range("E1").Value = TextBox3.Value
End With
End If
TextBox1.Value = Empty
TextBox2.Value = Empty
TextBox3.Value = Empty
Label1.Caption = Empty
skip = True
ComboBox1.ListIndex = -1
skip = False
End Sub
(ぶらっと)
書いていただいて申し訳ありませんが、コンボボックスで選ぶのは無理があります…データが2000行とかあるので…
テキストボックスにE列の入荷受付番号を入れて検索、というのは難しいのでしょうか
あと、D列が無くなったら「修正」を押した時に最初から入っている「00」（枝番なしの場合、または枝番の頭は必ず"00"）が無くなってしまいました… B～D列は必ずセットになっています。 具体的には
B列：日付記号（例2012年1月12日→120112） C列：その日の入荷記号（1/12に入ってくるものを0001から4ケタの連番で採番） D列：前述のように同じ商品内での枝番
という使い方で、それを結合して「入荷受付番号」にしたのがE列です。
自分でもテキストボックスからの検索を試してみます。
（雪だるま）
>テキストボックスにE列の入荷受付番号を入れて検索、というのは難しいのでしょうか
いや、簡単だよ。だけど、ちょっと勘違いしてるんじゃないかな？ コンボボックスは、テキストボックスとリストボックスの合体版。だから、｢箱の中に｣文字を入れることもできるんだよ。 で、テキストボックスより優れているのは、たとえば、1 と入力すると 1から始まる最初の値がボックスに自動検索されて表示されるし さらに続けて、たとえば5といれると15から始まる最初のデータが表示される。 このようにして、最後まで入力してもいいし、ある程度のところで▼をおすと、今表示されているデータを 先頭にしたリストになっているので選びやすくなっている。 だまされたと思って動かしてみたら？
枝番については、了解。というか、そのあたりは、そちらで好きなように。 例として限られた項目を扱っているけど、枝番も含めて抽出・入力項目にしたらいいんじゃないかな？ (挿入の場合は、アップしたロジックを適用してもいいと思うけど）
あぁ、それと、アップしてからしまったと。 コンボボックスへのリストのセット、Initializeで１回だけ行っているけど、ボタンによる更新の後にも 行わなきゃいけなかったね。
(ぶらっと)
ありがとうございます。 勘違いすみませんでした（汗） 確かにおっしゃるように検索できました！
枝番は
TextBox3.Value = TextBox1.Value & TextBox2.Value & TextBox3.Value '新入荷受付番号 ↓ TextBox3.Value = Cells(orgRow, "D").Value '枝番
にしました。
>コンボボックスへのリストのセット、Initializeで１回だけ行っているけど、ボタンによる更新の後にも >行わなきゃいけなかったね。
これを下手の考えで
Private Sub ComboBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
'挿入元の選択
Dim r As Range
If skip Then Exit Sub
orgRow = ComboBox1.ListIndex + 4
Label1.Caption = Cells(orgRow, "E").Value '入荷受付番号
TextBox1.Value = Cells(orgRow, "B").Value '荷受１
TextBox2.Value = Cells(orgRow, "C").Value '荷受２
TextBox3.Value = Cells(orgRow, "D").Value '枝番
With ComboBox1
.MatchRequired = True
.MatchEntry = fmMatchEntryComplete
End With
z = Range("E" & Rows.Count).End(xlUp).Row
ReDim v(4 To z)
For i = 4 To z
v(i) = Cells(i, "E").Value
Next
ComboBox1.List = v
End Sub
としたらユーザーフォームを閉じる時に「プロパティが無効です」のメッセージボックスが出るようになってしまいました。 そのままコピーしただけじゃダメなんでしょうか…
（雪だるま）
面白そうなので、私も作って見ました 思い付きで作っているので検証が未了ですので、無駄なコードとバグが有ると思います
1、入荷マスタのA列（番号）が先頭データを1番として抜けの無い連番が入っている物としています
2、絞り込みを行う為、作業用シートを使いますので作成して置いて下さい 作業用シートのシート名を「更新用」とします 第1行目にフィルタオプション用の列見出しを作ります（前回と同様、入荷マスタからCopyして下さい） 抽出範囲として、A1に「番号」（更新、レコード追加に必要）、B1に「荷受No(1)」、C1に「荷受No(2)」、D1に「枝番」、其れ以降に更新するフィールドの列見出しをCopyして来る（一応、Upするコードでは18列として在ります） 条件範囲として、AA1に「荷受No(1)」、AB1に「荷受No(2)」をCopyしてくる
3、UserFormのコントロールを以下とします ComboBox10：荷受No(1)入力用 ComboBox11：荷受No(2)入力用 ComboBox12：枝番入力用 TextBox4～7：更新データ表示用 ComboBox1～6：更新データ表示用 OptionButton1～2：更新データ表示用 CommandButton1：データ更新ボタン ComboBox10～12、CommandButton1以外は本物のデータに合わせて下さい 尚、「Sub CommandButton1_Click」、「Sub ClearControls」、「Sub PutControls」も実際のコントロールに合わせて下さい
4、UserFormのコードは以下とします
Option Explicit
Private rngList As Range '入荷マスタの列見出し先頭セル位置 Private rngWork As Range '作業用シートの抽出範囲 Private rngCrit As Range '作業用シートの条件範囲先頭セル位置 Private lngRows As Long 'List行数（最終行位置） Private lngColumns As Long 'List列数 Private dicIndex As Object 'Dictionary
Private Sub ComboBox10_Change()
Dim i As Long
Dim lngRow As Long
Dim vntData As Variant
'条件範囲にComboBoxの値を代入（式の形で）
rngCrit.Offset(1).Value = "=""" & ComboBox10.Value & """"
'AdvancedFilterを実行
DoFilter rngList.Resize(lngRows + 1, lngColumns), rngCrit.Resize(2), rngWork.Resize(, 18)
'抽出範囲から
With rngWork
'抽出行数を取得
lngRow = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
'列見出し以上の行が在るなら
If lngRow > 0 Then
If lngRow = 1 Then
ReDim vntData(1 To 1)
vntData(1) = .Offset(1, 2).Value
Else
'C列から、データを配列に取得し重複を取りComboBox11のListに設定
vntData = Unique(.Offset(1, 2).Resize(lngRow).Value)
End If
'目的列から、データを配列に取得し重複を取りComboBoxのListに設定
ComboBox11.List = vntData
Else
ComboBox11.Clear
ClearControls
End If
End With
End Sub
Private Sub ComboBox10_Enter()
ComboBox11.ListIndex = -1
With ComboBox12
.ListIndex = -1
.Clear
End With
ClearControls
End Sub
Private Sub ComboBox11_Change()
Dim i As Long
Dim lngRow As Long
Dim vntData As Variant
rngCrit.Offset(1, 1).Value = "=""" & ComboBox11.Value & """"
DoFilter rngList.Resize(lngRows + 1, lngColumns), rngCrit.Resize(2, 2), rngWork.Resize(, 18)
With rngWork
lngRow = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
If lngRow > 0 Then
If lngRow = 1 Then
ReDim vntData(1 To 1)
vntData(1) = .Offset(1, 3).Value
Else
vntData = .Offset(1, 3).Resize(lngRow).Value
End If
ComboBox12.List = vntData
ComboBox12.ListIndex = UBound(vntData, 1) - 1
Else
ComboBox12.Clear
ClearControls
End If
End With
End Sub
Private Sub ComboBox11_Enter()
ComboBox12.ListIndex = -1
ClearControls
End Sub
Private Sub ComboBox12_Change()
PutControls
End Sub
Private Sub UserForm_Initialize()
Dim i As Long
Dim vntData As Variant
'入荷マスタ先頭セル位置を指定
Set rngList = Worksheets("入荷マスター").Cells(3, "A")
'作業用シートの抽出範囲を指定
Set rngWork = Worksheets("更新用").Cells(1, "A")
'作業用シートの条件範囲先頭セル位置を指定
Set rngCrit = rngWork.Parent.Cells(1, "AA")
'Dictionaryオブジェクトを取得
Set dicIndex = CreateObject("Scripting.Dictionary")
'Listの行数、列数取得
With rngList
'行数の取得
lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
'列数の取得
lngColumns = .Offset(, Columns.Count - .Column).End(xlToLeft).Column - .Column + 1
'B列データを配列に取得
vntData = .Offset(1, 1).Resize(lngRows + 1).Value
End With
'B列（荷受No(1)）の重複取り、ComboBox10のListを設定
ComboBox10.List = Unique(vntData)
'マッチングを行いません
ComboBox12.MatchEntry = fmMatchEntryNone
End Sub
Private Sub UserForm_Terminate()
Set rngList = Nothing
Set rngWork = Nothing
Set rngCrit = Nothing
Set dicIndex = Nothing
End Sub
Private Sub CommandButton1_Click()
Dim lngRow As Long
Dim lngOffset As Long
With ComboBox12
If .ListIndex > -1 Then
lngRow = rngWork.Offset(.ListIndex + 1).Value
Else
If MsgBox("新しい行が挿入され、新規レコードと成ります", _
vbInformation + vbOKCancel) = vbCancel Then
Exit Sub
End If
lngOffset = rngWork.Row + 1
lngRow = rngWork.Offset(.ListCount).Value + 1
rngList.Offset(lngRow).EntireRow.Insert
End If
End With
'入荷マスタを更新
With rngList
lngRow = lngRow + 1
If ComboBox12.ListIndex = -1 Then
.Cells(lngRow, "A").Formula = "=ROW()-3"
.Cells(lngRow, "B").Value = ComboBox10.Text '荷受No(1)
.Cells(lngRow, "C").Value = ComboBox11.Text '荷受No(2)
.Cells(lngRow, "D").Value = Right("00" & ComboBox12.Text, 2) '枝番
.Cells(lngRow, "E").Formula = "=$B" & (lngRow + lngOffset) _
& "&$C" & (lngRow + lngOffset) _
& "&$D" & (lngRow + lngOffset)
'List最終行位置を更新
lngRows = lngRows + 1
End If
.Cells(lngRow, "F").Value = -CLng(OptionButton1.Value)
.Cells(lngRow, "G").Value = -CLng(OptionButton2.Value)
.Cells(lngRow, "H").Value = ComboBox1.Value
.Cells(lngRow, "I").Value = TextBox4.Text '伝票番号
.Cells(lngRow, "J").Value = TextBox5.Text '納品日
.Cells(lngRow, "K").Value = ComboBox2.Value
.Cells(lngRow, "L").Value = ComboBox3.Value
.Cells(lngRow, "M").Value = ComboBox4.Value
.Cells(lngRow, "N").Value = ComboBox5.Value
.Cells(lngRow, "O").Value = TextBox6.Text '在庫ID
.Cells(lngRow, "P").Value = ComboBox6.Value '品名
.Cells(lngRow, "Q").Value = TextBox7.Text '入荷予定数
End With
'変更が有る為再抽出
DoFilter rngList.Resize(lngRows + 1, lngColumns), rngCrit.Resize(2, 2), rngWork.Resize(, 18)
With rngWork
lngRow = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
If lngRow > 0 Then
If lngRow = 1 Then
ReDim vntData(1 To 1)
vntData(1) = .Offset(1, 3).Value
Else
vntData = .Offset(1, 3).Resize(lngRow).Value
End If
ComboBox12.List = vntData
ComboBox12.ListIndex = UBound(vntData, 1) - 1
Else
ComboBox12.Clear
ClearControls
End If
End With
End Sub
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
'B列（荷受No(1)）の重複取り
For i = 1 To UBound(vntData, 1)
If Not IsEmpty(vntData(i, 1)) Then
dicIndex(vntData(i, 1)) = Empty
End If
Next i
'戻り値として重複無しの値を返す
Unique = dicIndex.Keys
'Dictonaryの登録を全て破棄
dicIndex.RemoveAll
End Function
Private Sub ClearControls()
OptionButton1.Value = False
OptionButton2.Value = False
ComboBox1.Value = ""
TextBox4.Text = "" '伝票番号
TextBox5.Text = "" '納品日
ComboBox2.Value = ""
ComboBox3.Value = ""
ComboBox4.Value = ""
ComboBox5.Value = ""
TextBox6.Text = "" '在庫ID
ComboBox6.Value = "" '品名
TextBox7.Text = "" '入荷予定数
End Sub
Private Sub PutControls()
Dim lngRow As Long
With ComboBox12
If .ListIndex = -1 Then
Exit Sub
Else
lngRow = .ListIndex + 1
End If
End With
'抽出範囲先頭位置因り
With rngWork
OptionButton1.Value = .Offset(lngRow, 4).Value 'F列
OptionButton2.Value = .Offset(lngRow, 5).Value 'G列
ComboBox1.Value = .Offset(lngRow, 6).Value 'H列
TextBox4.Text = .Offset(lngRow, 7).Value '伝票番号
TextBox5.Text = .Offset(lngRow, 8).Value '納品日
ComboBox2.Value = .Offset(lngRow, 9).Value
ComboBox3.Value = .Offset(lngRow, 10).Value
ComboBox4.Value = .Offset(lngRow, 11).Value
ComboBox5.Value = .Offset(lngRow, 12).Value
TextBox6.Text = .Offset(lngRow, 13).Value '在庫ID
ComboBox6.Value = .Offset(lngRow, 14).Value '品名
TextBox7.Text = .Offset(lngRow, 15).Value '入荷予定数
End With
End Sub
5、使い方は、UserFormを表示しComboBox10から「荷受No(1)」を選択するか、手入力します 次にComboBox11から「荷受No(2)」をを選択するか、手入力します 上記選択がなされると、ComboBox12に「枝番」が表示されますので、枝番を選択して各コントロールの値を変更し CommandButton1を押すと、選択されている枝番のレコードが更新されます また、新規に枝番のレコードを追加する場合は、ComboBox12に追加する枝番を手入力します そして、各コントロールの値を変更入力してCommandButton1を押せば、入力した枝番がComboBox12のListに無ければ 新規レコードが挿入され転記されます、挿入場所はComboBox12のListの最終データの下と成ります
(Bun)
ぶらっと様
>コンボボックスへのリストのセット、Initializeで１回だけ行っているけど、ボタンによる更新の後にも >行わなきゃいけなかったね。
この件、私が書く場所を間違えていました。
Private Sub CommandButton1_Click()
（略）
With ComboBox1
.MatchRequired = True
.MatchEntry = fmMatchEntryComplete
End With
z = Range("E" & Rows.Count).End(xlUp).Row
ReDim v(4 To z)
For i = 4 To z
v(i) = Cells(i, "E").Value
Next
ComboBox1.List = v
こうしましたが大丈夫でしょうか（今のところ普通に動いています）
あと、枝番を作って行を挿入した際にE列とS列に参照式を入れたいのですが、元々の参照式は、データ行が10行目の場合 E10 =B10&C10&D10 S10 =R10 となっています。
Private Sub CommandButton1_Click()
で
.Range("E1").Value = "=B1&C1&D1"
.Range("S1").Value = Cells(orgRow, "R")
としましたがE列は文字列としてそのまま =B1&C1&D1 の文字が入り、S列はR列の一つ前（枝番作成前）の行の値が入ります（式にならない）
ここはどのようにしたらよいのでしょうか？
Bun様ありがとうございます。
これから教えていただいたコードを試してみます。
（雪だるま）
まず、コンボボックスへのリストのセットの件、同じコードを２回かくのもうまくないし 従来はInitializeだけだったので問題なかったけど、実行中の変更なのでイベントの抑止をいれる必要がある。
以下のようにしたらいかが？ （なお、数式セットの件は後ほど）
Private Sub UserForm_Initialize()
Label1.Caption = Empty
With ComboBox1
.MatchRequired = True
.MatchEntry = fmMatchEntryComplete
End With
Call ListSet
OptionButton1.Caption = "新規"
OptionButton2.Caption = "修正"
OptionButton3.Caption = "削除"
OptionButton4.Caption = "枝番挿入"
OptionButton1.Value = True '初期値 実際に初期値にふさわしいものに適宜変更
End Sub
CommandButton1_Click の最後
今、
skip = True
ComboBox1.ListIndex = -1
skip = False
これを
skip = True
Call ListSet
skip = False
に変更。
で、以下を追加。
Private Sub ListSet()
Dim z As Long
Dim i As Long
Dim v() As String
z = Range("E" & Rows.Count).End(xlUp).Row
ReDim v(4 To z)
For i = 4 To z
v(i) = Cells(i, "E").Value
Next
ComboBox1.List = v
ComboBox1.ListIndex = -1
End Sub
(ぶらっと)
数式セットの件、数式にはならないけど以下ではいかが？（どうしても数式ということなら、また考えるけど）
.Range("E1").Value = .Range("B1").Value & .Range("C1").Value & .Range("D1").Value
.Range("S1").Value = .Range("R1").Value
(ぶらっと)
ぶらっと様 ありがとうございます。
数式の件大丈夫です。
それで、こちらで実際に入力する時の利便性に合わせてコードをいじっていました。
・OptionButton4"枝番挿入"が選択されている時 ↓ コマンドボタン1クリック時 *コンボボックス１・テキストボックス１～２はそのまま残す *テキストボックス3（枝番）は挿入した枝番を表示（00から01を作成したなら、01を表示） *テキストボックス7～15のみクリア
・OptionButton2以外が選択されている時 ↓ コマンドボタン1クリック時にフォーム内の全ての値をクリア
という動作にしたいと思い、下記のコードを書きました。 （不要部分を省略しています）
Private Sub CommandButton1_Click()
'データシート反映
Dim seq As Long
Dim myRow As Long
Dim com1 As String
Dim tb1 As String
Dim tb2 As String
Dim tb3 As String
Dim i As Long
Dim ctrl As Control
If ComboBox1.ListIndex < 0 Then
MsgBox "元データが選択されていません"
Exit Sub
End If
If OptionButton3 Then '削除
Rows(orgRow).Delete
Else
If OptionButton1.Value Then '新規
seq = 0
myRow = Range("D" & Rows.Count).End(xlUp).Row + 1
ElseIf OptionButton2 Then '修正
seq = Val(Cells(orgRow, "D").Value)
myRow = orgRow
Else '挿入
seq = Val(Cells(orgRow, "D").Value) + 1
Rows(orgRow + 1).Insert Shift:=xlDown
myRow = orgRow + 1
tb1 = TextBox1.Value
tb2 = TextBox2.Value
tb3 = TextBox3.Value
com1 = ComboBox1.Value
End If
With Rows(myRow)
.Range("A1").Formula = "=ROW()-3"
.Range("B1").Value = TextBox1.Value
.Range("C1").Value = TextBox2.Value
.Range("D1").Value = Format(seq, "00")
.Range("E1").Value = .Range("B1").Value & .Range("C1").Value & .Range("D1").Value
（略）
End With
End If
If OptionButton4.Value = True Then
TextBox1.Value = tb1
TextBox2.Value = tb2
TextBox3.Value = tb3
ComboBox1.Value = com1
For i = 7 To 15
Controls("TextBox" & i) = ""
Next
Else
For Each ctrl In Me.Controls
If TypeName(ctrl) = "TextBox" Then _
ctrl.Value = vbNullString
Next
For Each ctrl In Me.Controls
If TypeName(ctrl) = "ComboBox" Then _
ctrl.Value = vbNullString
Next
skip = True
Call ListSet
skip = False
End If
End Sub
これで実行したのですが、「枝番挿入」が選択されている場合にテキストボックス３の「枝番」（D列）に新しい枝番が入りません。
新しい枝番を入れるにはどこを変更すればよいでしょうか
（雪だるま）
すみません、自己解決しました…
Else '挿入
seq = Val(Cells(orgRow, "D").Value) + 1
Rows(orgRow + 1).Insert Shift:=xlDown
myRow = orgRow + 1
tb3 = Format(seq, "00")
これで新しい枝番が入りました あとtb1、tb2、com1の変数は必要ないのが分かったので外しました。
（雪だるま）
自己解決ということだけど、気になっているところがあって、自己解決レスを読む前に書いたものが以下。
まず、値をクリアしているところだけど If OptionButton4.Value = True Then つまり、挿入の時のみクリア？ それでいいの？ ・OptionButton4"枝番挿入"が選択されている時 ↓ ・OptionButton2以外が選択されている時 ↓ このように書いているけど？
さらに、この処理（挿入の時のみ）の中で、リストの入れ替えを行っている。 削除や追加の時はリストがいれかわらないけど、いいの？
で、本題。
コードを見る限り、削除以外は、OptionButtonがなんであろうと、.Range("D1").Value = Format(seq, "00") が実行されるはずだけど？
気になるのは、コンボボックスの値をいれかえている。ここで、意図しないイベントが発生している。
とりあえず、
For Each ctrl In Me.Controls
If TypeName(ctrl) = "ComboBox" Then _
ctrl.Value = vbNullString
Next
skip = True
Call ListSet
skip = False
これを
skip = True
For Each ctrl In Me.Controls
If TypeName(ctrl) = "ComboBox" Then _
ctrl.Value = vbNullString
Next
Call ListSet
skip = False
このようにかえてやったらどうかな？
(ぶらっと)
ありがとうございます。
>If OptionButton4.Value = True Then つまり、挿入の時のみクリア？ それでいいの？ >・OptionButton4"枝番挿入"が選択されている時 > ↓ >・OptionButton2以外が選択されている時 > ↓ >このように書いているけど？
すみません、書き間違いです。 OptionButton4"枝番挿入"が選択されている時のみ新しい枝番を表示＆テキストボックス7～15をクリア、 それ以外が選択されている時は全ての値をクリアです。
なので
If OptionButton4.Value = True Then '枝番挿入の時
TextBox3.Value = tb3 'テキストボックス3に新しい枝番を表示
For i = 7 To 15
Controls("TextBox" & i) = "" 'テキストボックス7～15をクリア
Next
Else 'それ以外の時は下記のコードでフォームをクリア
For Each ctrl In Me.Controls
If TypeName(ctrl) = "TextBox" Then _
ctrl.Value = vbNullString
Next
skip = True
For Each ctrl In Me.Controls
If TypeName(ctrl) = "ComboBox" Then _
ctrl.Value = vbNullString
Next
Call ListSet
skip = False
End If
としましたがおかしいでしょうか… （今追加で書いていただいたコードは書き換えました。）
>削除や追加の時はリストがいれかわらないけど、いいの？
もしかしてこのためでしょうか。 今テストしていたら、コンボボックスに入荷受付番号を入力すると、違うレコード（1行前のレコード）が表示されました… ※16:21追記 今は正常に表示されました 先程は何故かおかしかったのですが… 削除や追加の時にリストが入れ替わらない、というのは該当行にデータが入らないということでしょうか？（見当違いだったらすみません）
何か色々いじってたら自分のコードはだめだめですね…＞＜
（雪だるま）
>削除や追加の時にリストが入れ替わらない、というのは該当行にデータが入らないということでしょうか？（見当違いだったらすみません）
いや、そうじゃなく、たとえば最初１０行あったとするとコンボボックスのリストには１０行存在（あたりまえだよね） で、たとえば追加したとしよう。すると、１１行のデータがあるはずだけど、コンボボックスのリストを最初にセットしたままにすると その後、フォームを閉じないで、連続して処理しようとした時に、その追加行は存在しないということになる。 逆に、削除した場合、データとしては存在しないのに、コンボボックスの中では存在することになってしまう。
で、あとは自助努力で大丈夫だとは思うけど、何か、つまずいたらＳＯＳ出してくれればお手伝いする。 （その時は、現在、そちらで完成させたコードのアップをしてもらわないと対応できないと思うけどね）
(ぶらっと)
>フォームを閉じないで、連続して処理しようとした時に、その追加行は存在しないということになる。 そういうことでしたか！ あわわ、それは困ります…私どこでそれを変えてしまったんでしょう…
あと追加で質問ですが、「新規」を選択してデータを入力する際、コンボボックス1に値を入れないと 「元のデータが選択されていません」のエラーが出ますが、そこに新しい入荷受付番号を入れると 「プロパティの値が正しくありません」というエラーがひたすら出てエラーメッセージ自体を閉じられないような状態になります。 エラーメッセージだけで「デバッグ」の項目がないのでどこでエラーになっているか分かりません… これはどういうエラーなんでしょうか？
（雪だるま）
新規でエラーが出る件、再び自己解決しました…
If OptionButton1.Value = False Then
If ComboBox1.ListIndex < 0 Then
MsgBox "元データが選択されていません"
Exit Sub
End If
End If
新規のボタンが選ばれた時はエラーメッセージを出さずに書き込むようにしました。
（雪だるま）
例によって、コメントを書いている間に自己解決ということで重畳。 でも、ちょっと気になるので一応アップしておく。（そちらの対応だけでは、もしかしたら不十分かも）
>「新規」を選択してデータを入力する際・・・・これはどういうエラーなんでしょうか？
わゎ！そうだね！ごめん。
元々、挿入ベースのコードを書いていて、だから、リストにあるもの以外の入力は禁止というセッティング。
新規だから、元々シートにはない値が入るんだよね。
対処は難しくないんだけど、｢新規かどうか｣、今までのコードは、コマンドボタンが押されるまでに選べばよかったけど この対応をすると、コンボボックスに入れる前に選んでおく必要がでてくる。 （逆の言い方をするとコンボボックスに入った時の扱いをオプションボタンの値でかえるということになる）
ということなんだけど、今、実は、猛烈に｢風邪気味｣ こんばんは早く寝て、明日には回復させるつもりなので、コードは明日まで待ってくれる？
(ぶらっと)
>実は、猛烈に｢風邪気味｣ そうなんですか！ お風邪のところを色々教えていただいて本当にありがとうございます。 お身体、お大事になさってください。 コードは体調がよくなられてからで大丈夫です！
（雪だるま）
そちらで、対象とするテキストボックス等、増やしたり、あるいはセットロジックを整備していると思うので そのあたりは割愛して、コードの骨格のみ。
まず、UserForm_Initialize で .MatchRequired = False としているところを .MatchRequired = False '★ リスト以外のデータ入力ＯＫ
で、現行の ComboBox1_BeforeUpdate これを ComboBox1_Change に変更したうえで以下。 個人的には１文字入力ごとにイベントが発生するChangeイベントは、あまり使わないようにしているんだけど 今回は、Changeイベントのほうが操作しやすいと思う。これにより、リスト内とマッチした瞬間にテキストボックス等に データが抽出される。
Private Sub ComboBox1_Change()
'挿入元の選択
Dim r As Range
If skip Then Exit Sub
If ComboBox1.ListIndex < 0 Then
orgRow = 0
Exit Sub 'コンボボックス内からの選択でない場合は何もしない
End If
orgRow = ComboBox1.ListIndex + 4
'★ここでorgRow行からテキストボックス等へのセット
End Sub
で、CommandButton1_Click を以下に。
Private Sub CommandButton1_Click()
'データシート反映
Dim seq As Long
Dim myRow As Long
If Not OptionButton1 And orgRow = 0 Then
'新規以外はリストからの選択必須
MsgBox "元データが選択されていません"
Exit Sub
End If
'★ここでOptionButtonの選択のされ方によりそれぞれの転記（削除）処理
skip = True
'★ここでテキストボックスなどのクリア処理
Call ListSet
skip = False
End Sub
(ぶらっと)
ぶらっと様
お身体大丈夫ですか？ おかげさまで新規登録もうまくできました。 ご体調のすぐれないところをありがとうございました！ お大事になさってくださいm(__)m
Bun様
昨日は余裕がなかったので教えていただいたコード、改めて試します！
（雪だるま）
すみません…解決したと思ったのですが…
多分 >削除や追加の時はリストがいれかわらないけど、いいの？ これの影響だと思いますが、たとえば10行目のレコードを呼び出し、枝番を追加して11行目に行挿入した後、 枝番挿入後に12行目になったデータ（元々11行目にあったはずのデータ）を呼び出すと、枝番挿入して新しく11行目になったデータ （つまり1行前のデータ）が呼び出されます。 ユーザーフォームを一度閉じるとちゃんと12行目のデータが表示されます。
実行時にリストを更新するにはどうしたらよいのでしょうか…
現在のコマンドボタン１（実行）クリック時のコード抜粋
Private Sub CommandButton1_Click()
'データシート反映
Dim seq As Long
Dim myRow As Long
Dim tb3 As String
Dim cnt As Long
Dim ctrl As Control
If OptionButton3 Then '削除
Rows(orgRow).Delete
Else
If Not OptionButton1 And orgRow = 0 Then
'新規以外はリストからの選択必須
MsgBox "元データが選択されていません"
Exit Sub
End If
If OptionButton1.Value Then '新規
seq = 0
myRow = Range("D" & Rows.Count).End(xlUp).Row + 1
ElseIf OptionButton2 Then '修正
seq = Val(Cells(orgRow, "D").Value)
myRow = orgRow
Else '挿入
seq = Val(Cells(orgRow, "D").Value) + 1
Rows(orgRow + 1).Insert Shift:=xlDown
myRow = orgRow + 1
tb3 = Format(seq, "00")
End If
（データをそれぞれのコントロールに呼び出し）
If OptionButton4.Value = True Then
TextBox3.Value = tb3
For cnt = 7 To 15
Controls("TextBox" & cnt) = ""
Next
Else
skip = True
For Each ctrl In Me.Controls
If TypeName(ctrl) = "TextBox" Then _
ctrl.Value = vbNullString
Next
For Each ctrl In Me.Controls
If TypeName(ctrl) = "ComboBox" Then _
ctrl.Value = vbNullString
Next
Call ListSet
skip = False
End If
End Sub
(雪だるま）
アップしてもらったコードは、不完全なんだけど（If/End If が対になっていない） そこを補って、なおかつ、制御文だけにすると以下。 よぉく見てもらえばわかると思うけど・・・ 肝心の ★★★ の リストの再セット、挿入｢以外のときのみ｣実行してるね。 だから、結果として、挿入の後には不具合がでてくるね。
あぁ、それと、気になっているんだけど、コンボボックスもループさせているけど複数あるの？
まぁ、そこは、いいとして、以下のように整理していたら、１つ発見したことがある。 ListSetの一番最後に orgRow = 0 をいれておいて。 一度、更新して、次にコンボボックスから何も選ばないで何かの処理をしたときに 元の行番号が残っていて、その行に対して、間違ったものを書き込んでしまうケースがあるので。
いずれにしても、更新後は、必ず ListSet を実行することが必要だよ。
Private Sub CommandButton1_Click()
If OptionButton3 Then '削除
'処理
Else
If Not OptionButton1 And orgRow = 0 Then
'新規以外はリストからの選択必須
MsgBox "元データが選択されていません"
Exit Sub
End If
If OptionButton1.Value Then '新規
'処理
ElseIf OptionButton2 Then '修正
'処理
Else '挿入
'処理
End If
If OptionButton4.Value = True Then
'処理
Else
skip = True
'処理
Call ListSet '★★★
skip = False
End If
End If
End Sub
(ぶらっと)
ありがとうございます。
Call ListSet をIF文から外して下記のようにしたらリストが更新されるようになったみたいです（多分…）
If Not OptionButton1 And orgRow = 0 Then
'新規以外はリストからの選択必須
MsgBox "元データが選択されていません"
Exit Sub
End If
If OptionButton3 Then '削除
Rows(orgRow).Delete
Else
If OptionButton1.Value Then '新規
seq = 0
myRow = Range("D" & Rows.Count).End(xlUp).Row + 1
ElseIf OptionButton2 Then '修正
seq = Val(Cells(orgRow, "D").Value)
myRow = orgRow
Else '挿入
seq = Val(Cells(orgRow, "D").Value) + 1
Rows(orgRow + 1).Insert Shift:=xlDown
myRow = orgRow + 1
tb3 = Format(seq, "00")
End If
With Rows(myRow)
（各セルに値記入）
End With
End If
skip = True
If OptionButton4.Value = True Then
TextBox3.Value = tb3
For cnt = 7 To 15
Controls("TextBox" & cnt) = ""
Next
Else
For Each ctrl In Me.Controls
If TypeName(ctrl) = "TextBox" Then _
ctrl.Value = vbNullString
Next
For Each ctrl In Me.Controls
If TypeName(ctrl) = "ComboBox" Then _
ctrl.Value = vbNullString
Next
End If
Call ListSet
skip = False
コンボボックスは最初に選択する分も含めて7個あります。 その他テキストボックス15個、「新規」～などを選ぶのとは別のグループのオプションボタンが2個です。
これでまたテストしてみます。
（雪だるま）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.