[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『入荷データ入力時の枝番生成（２）』（雪だるま）
上記の質問で入荷マスターにデータを登録する際に枝番を生成する方法を教えていただきました。
ぶらっと様、BUN様にご回答をいただいていたのですが、どうしても分からないところがあるのでお願いします。
ぶらっと様から教えていただいたコードをこちらで数か所変更しながら使用していたのですが、 このコードでは新しい枝番を生成する際に、 「選択しているデータの“次の数字”の枝番が生成される」 ので、例えば 120222000100 120222000101 ： 120222000108
のように入力して次の枝番を「09」にして「120222000109」としなければいけないところを、 元データとして「120222000101」を選んでしまうと次のデータが「120222000102」になり、 枝番「02」が二つできてしまいます。
できればどの枝番のデータを選んでも、最後の枝番の次の番号を生成するようにしたいのですが どのようにすればよいかわかりません。
Bun様のコードを試してみましたが、何故かデータを呼び出してユーザーフォーム内に表示する時点で、 オプションボタンの部分から先のデータが1列ずつずれて表示されてしまい、どこを訂正すれば 正しく表示できるか分かりませんでした… ↓ OptionButton1…F列 OptionButton2…G列 ComboBox1…H列 ： と表示されなければならないのに OptionButton1…データ無し OptionButton2…F列 ComboBox1…G列 となってしまう
ぶらっと様のコードにこちらで変更を加えているものは下記の通りです。
Option Explicit
Private dicIndex As Object Dim orgRow As Long Dim skip As Boolean
Private Sub UserForm_Initialize()
'Dictionaryオブジェクトを取得
Set dicIndex = CreateObject("Scripting.Dictionary")
Dim z As Long
Dim i As Long
Dim j() As String
Dim lRow As String
Dim y As Variant
With ThisWorkbook.Worksheets("出荷元マスター")
lRow = .Range("L" & .Rows.Count).End(xlUp).Row
y = .Range("C2:C" & lRow).Value
End With
With ComboBox7
.RowSource = "出荷元マスター!D2:D" & lRow
End With
With ComboBox2
.RowSource = "出荷元マスター!A2:A" & lRow
End With
With ComboBox3
.RowSource = "出荷元マスター!B2:B" & lRow
End With
With ComboBox4
.RowSource = "出荷元マスター!J2:J" & lRow
End With
With ComboBox5
.RowSource = "出荷元マスター!L2:L" & lRow
End With
Label1.Caption = Empty
With ComboBox1
.MatchRequired = False '★ リスト以外のデータ入力ＯＫ
.MatchEntry = fmMatchEntryComplete
End With
Call ListSet
OptionButton1.Caption = "新規"
OptionButton2.Caption = "上書"
OptionButton3.Caption = "削除"
OptionButton4.Caption = "枝番挿入"
OptionButton1.GroupName = "G-1"
OptionButton2.GroupName = "G-1"
OptionButton3.GroupName = "G-1"
OptionButton4.GroupName = "G-1"
OptionButton6.GroupName = "G-2"
OptionButton7.GroupName = "G-2"
OptionButton2.Value = True '初期値 実際に初期値にふさわしいものに適宜変更
End Sub Private Sub UserForm_Terminate()
'Dictionaryオブジェクトを破棄
Set dicIndex = Nothing
End Sub
Private Sub TextBox6_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim i As Long
Dim lngRows As Long
Dim vntMark As Variant
Dim vntData As Variant
ComboBox6.Text = ""
With Worksheets("資材マスター").Range("A1") '☆変更
'行数の取得(A列最終行)
lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
If lngRows <= 0 Then
ComboBox1.Clear
Exit Sub
End If
'A、B列データを配列に取得
vntData = .Offset(1).Resize(lngRows + 1, 2).Value
End With
vntMark = TextBox6.Value
For i = 1 To lngRows
'A列の値がTextBox6の値と等しいなら
If vntData(i, 1) = vntMark Then
'DictionaryにB列の値をKeyとして登録
dicIndex.Item(vntData(i, 2)) = Empty
End If
Next i
'Dictionryに登録が有ったなら
If dicIndex.Count > 0 Then
vntData = dicIndex.Keys
With ComboBox6
'ComboBoxにB列を登録
.List = vntData
'先頭行を表示
.ListIndex = 0
End With
Else
ComboBox6.Clear
End If
dicIndex.RemoveAll
End Sub
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行からテキストボックス等へのセット
Label1.Caption = Cells(orgRow, "E").Value '入荷受付番号
TextBox1.Value = Cells(orgRow, "B").Value '荷受１
TextBox2.Value = Cells(orgRow, "C").Value '荷受２
TextBox3.Value = Cells(orgRow, "D").Value '枝番
ComboBox7.Value = Cells(orgRow, "H").Value '区分
TextBox4.Value = Cells(orgRow, "I").Value '伝票No
If Cells(orgRow, "F").Value = 1 Then
OptionButton6 = True '情報有
Else
OptionButton6 = False
End If
If Cells(orgRow, "G").Value = 1 Then
OptionButton7 = True '情報無
Else
OptionButton7 = False
End If
TextBox5.Value = Cells(orgRow, "J").Value '納品日
ComboBox2.Value = Cells(orgRow, "K").Value 'ｸﾗｲｱﾝﾄ情報
ComboBox3.Value = Cells(orgRow, "L").Value '納品場所
ComboBox4.Value = Cells(orgRow, "M").Value '出庫部署
ComboBox5.Value = Cells(orgRow, "N").Value '納品業者
TextBox6.Value = Cells(orgRow, "O").Value '在庫ID
ComboBox6.Value = Cells(orgRow, "P").Value '品名
TextBox7.Value = Cells(orgRow, "Q").Value '入荷予定数
TextBox8.Value = Cells(orgRow, "R").Value '入荷実数
TextBox9.Value = Cells(orgRow, "AA").Value '束内数
TextBox10.Value = Cells(orgRow, "AB").Value '束数
TextBox11.Value = Cells(orgRow, "AC").Value '使用期限年
TextBox12.Value = Cells(orgRow, "AD").Value '使用期限月
TextBox13.Value = Cells(orgRow, "AE").Value '使用期限日
TextBox14.Value = Cells(orgRow, "AF").Value '記号
TextBox15.Value = Cells(orgRow, "AK").Value 'パレット
End Sub
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 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)
.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
If OptionButton6.Value = True Then
.Range("F1").Value = 1
Else
.Range("F1").Value = 0
End If
If OptionButton7.Value = True Then
.Range("G1").Value = 1
Else
.Range("G1").Value = 0
End If
.Range("H1").Value = ComboBox7.Value
.Range("I1").Value = TextBox4.Value
.Range("J1").Value = TextBox5.Value
.Range("K1").Value = ComboBox2.Value
.Range("L1").Value = ComboBox3.Value
.Range("M1").Value = ComboBox4.Value
.Range("N1").Value = ComboBox5.Value
.Range("O1").Value = TextBox6.Value
.Range("P1").Value = ComboBox6.Value
.Range("Q1").Value = TextBox7.Value
.Range("R1").Value = TextBox8.Value
.Range("S1").Value = .Range("R1").Value
.Range("AA1").Value = TextBox9.Value
.Range("AB1").Value = TextBox10.Value
.Range("AC1").Value = TextBox11.Value
.Range("AD1").Value = TextBox12.Value
.Range("AE1").Value = TextBox13.Value
.Range("AF1").Value = TextBox14.Value
.Range("AK1").Value = TextBox15.Value
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
End Sub
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
orgRow = 0
End Sub
Private Sub CommandButton3_Click()
Unload Me
End Sub
Private Sub CommandButton2_Click()
Dim ctrl As Control
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 Sub
自動で最後の枝番を取得してその次の番号を生成する方法がありましたらお教えください。
>Bun様のコードを試してみましたが、何故かデータを呼び出してユーザーフォーム内に表示する時点で、 >オプションボタンの部分から先のデータが1列ずつずれて表示されてしまい、どこを訂正すれば >正しく表示できるか分かりませんでした… >↓ >OptionButton1…F列 >OptionButton2…G列 >ComboBox1…H列 > ： >と表示されなければならないのに >OptionButton1…データ無し >OptionButton2…F列 >ComboBox1…G列 >となってしまう
此れは、抽出用の「更新用」シートを作る時に、F列、G列の列見出しの前に1列余計に入っている為に起こっています 修正は、「更新用」シートのフィールドを変更するか？
「Sub PutControls」の
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 '入荷予定数
の列Offsetを一つ右にシフトします
例として
OptionButton1.Value = .Offset(lngRow, 5).Value 'F列
多分、此れだけで済むと思います
(Bun)
>次の枝番を「09」にして「120222000109」としなければいけないところを、 >元データとして「120222000101」を選んでしまうと次のデータが「120222000102」になり、 >枝番「02」が二つできてしまいます。
希望の要件としてはクリアに理解できるけど、全体の仕様、コードの構成ともに、すっかり忘却のかなたで 関連のトピを最初からじっくり読んで、やりとりをなぞりながら思い出してみるけど時間かかりそう・・？
こちらが質問するのはおかしいかもしれないけど、枝番（？）設定しているのは
Else '挿入
seq = Val(Cells(orgRow, "D").Value) + 1
Rows(orgRow + 1).Insert Shift:=xlDown
myRow = orgRow + 1
tb3 = Format(seq, "00")
ここだったっけ？
それと、（思い出して対応できるようになったとして）枝番なるものが99まで到達していたらどうする？
(ぶらっと)
>Bun様 ありがとうございます。 フィールドを変更したら正しく表示されるようになりました。 これは新しい枝番は自分で入力して登録するようになっているのですね。
>ぶらっと様 ありがとうございます。
はい、枝番を設定しているのはその部分です。
>枝番なるものが99まで到達していたらどうする？ まずあり得ないですが、仮に発生したら99の次は100、101…と続けていきたいです。
★追記
Bun様 データは表示できるようになりましたが、入荷予定として既に入力されているデータを選択して 入荷実数を入力→登録するとそれが新しいデータとして登録されてしまいます… 前トピでも説明不足でご迷惑をおかけしたのですが、
>このユーザーフォームは「枝番生成」が前提ではなく、
>① 入荷予定入力されたデータに、実際に入荷した時に数量などの詳細データを入力したい。 >② ①の過程で「場合によっては」枝番生成の必要が出てくるので、その場合は元の行をコピーして枝番をつけたデータを追加したい。
なので毎回新規データを登録するわけではないのです…
（雪だるま）
>これは新しい枝番は自分で入力して登録するようになっているのですね。
はい其の通りです、何故なら枝番が連続している物か解らないので勝手枝番を振らない方がいいだろうと 言う観点から振っていません ただ、枝番の最終番号はComboBox12のプルダウンを見れば解りますので（プルダウンの最終行が最終番号） その次の番号をComboBox12に手入力すれば善いと思いますが？
>データは表示できるようになりましたが、入荷予定として既に入力されているデータを選択して >入荷実数を入力→登録するとそれが新しいデータとして登録されてしまいます… >前トピでも説明不足でご迷惑をおかけしたのですが、 > >>このユーザーフォームは「枝番生成」が前提ではなく、 > >>① 入荷予定入力されたデータに、実際に入荷した時に数量などの詳細データを入力したい。 >>② ①の過程で「場合によっては」枝番生成の必要が出てくるので、その場合は元の行をコピーして枝番をつけたデータを追加したい。
いえ、このUserFormは既存データの修正更新が目的で、その中に枝番生成も含まれています 詰まり、上記①②をコーディングした積りです
ただ、後で幾つか不都合が有ったのですが？、ぶらっとさんのコードを使う様だったので其れはUpしませんでした
不都合は、 1、ComboBox12のTextBox部を消して""にした場合でも、CommandButtonを押すと新規レコードが出来てしまう 2、ComboBox12のTextBox部に例えば「1」と入力した場合、「01」が有っても新規レコードが出来てしまう と言う物でした
この点を修正した差分のコードをUpして置きます
「2、」を修正する為以下のプロシージャを追加
Private Sub ComboBox12_Exit(ByVal Cancel As MSForms.ReturnBoolean) '★追加
With ComboBox12 '★追加
.Text = Right("00" & .Text, 2) '★追加
End With '★追加
End Sub '★追加
「1、」を修正する為、以下を追加修正
Private Sub CommandButton1_Click()
Dim lngRow As Long
Dim lngOffset As Long
If ComboBox10.ListIndex = -1 Or ComboBox11.ListIndex = -1 Then '★追加
Exit Sub '★追加
End If '★追加
・
・
'入荷マスタを更新
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, "D").Value = ComboBox12.Text '枝番 ★変更
.Cells(lngRow, "E").Formula = "=$B" & (lngRow + lngOffset) _
多分これで修正出来ると思います 上記修正を終われば
>② ①の過程で「場合によっては」枝番生成の必要が出てくるので、その場合は元の行をコピーして枝番をつけたデータを追加したい。
此れを行うなら、先ずComboBox12でコピーしたい枝番を選択します 選択が終われば、各コントロールにデータが呼び出されますので 修正する所を直し、ComboBox12のTextBox部に新しい枝番を入力し、CommandButtonを押します そうすれば、新規レコードが追加されます （枝番ComboBox12の値を先に変更してデータを変更でもOK）
既存データの変更修正の場合も同様に変更したい、枝番をComboBox12で選択して データを変更修正してComboBox12の値を変更せずCommandButton押せば、選択されているレコードに上書されます
(Bun)
自信度は５５％ぐらいだけど・・・ seq = Val(Cells(orgRow, "D").Value) + 1 これを seq = GetSeq(orgRow) にかえて、同じモジュールに以下のプロシジャを追加。
Private Function GetSeq(orgRow As Long) As Long
Dim id1 As String
Dim id2 As String
Dim x As Long
Dim y As Long
Dim z As Long
Dim nKey As String
Dim maxSeq As Long
id1 = Cells(orgRow, "B").Value
id2 = Cells(orgRow, "C").Value
z = Range("B" & Rows.Count).End(xlUp).Row
x = WorksheetFunction.Match(id1, Range("B1:B" & z), 0)
y = WorksheetFunction.Match(id2, Range("C" & x & ":C" & z), 0) + x - 1
For z = y To z
If Cells(z, "B").Value & vbTab & Cells(z, "C").Value <> id1 & vbTab & id2 Then Exit For
maxSeq = WorksheetFunction.Max(maxSeq, Val(Cells(z, "D").Value))
Next
GetSeq = maxSeq + 1
End Function
(ぶらっと)
>Bun様 ありがとうございます。
試してみてデータの上書き・枝番生成ともできるようです。 まだ全部のデータを入力できる準備ができていないので、明日また試してみます
>ぶらっと様 ありがとうございます。
最新の枝番生成には成功しましたが、元データの次の行に追加されるので、例えば
120222000100 120222000101 ： 120222000108
これの「01」を元データにして枝番を挿入すると
120222000100 120222000101 120222000109 ： 120222000108
という並びになります。
できれば枝番の順番に並べたいのですが…
（雪だるま）
テスト環境を準備しておらず、目視でのデバッグだけなので自信度４５％
・ユーザーフォームモジュールの最初、宣言部に以下
Private Type Ans
seq As Long
pos As Long
End Type
・CommandButton1_Click の最初に Dim seqinfo As Ans を追加。
・seq を取得しているところ
Else '挿入
seq = GetSeq(orgRow)
Rows(orgRow + 1).Insert Shift:=xlDown
myRow = orgRow + 1
これを
Else '挿入
seqinfo = GetSeq(orgRow) 'アップ後、訂正
seq = seqinfo.seq
orgRow = seqinfo.pos
Rows(orgRow + 1).Insert Shift:=xlDown
myRow = orgRow + 1
で、 GetSeq をリバイス
Private Function GetSeq(orgRow As Long) As Ans
Dim id1 As String
Dim id2 As String
Dim x As Long
Dim y As Long
Dim z As Long
Dim nKey As String
Dim pos As Long
Dim maxSeq As Long
id1 = Cells(orgRow, "B").Value
id2 = Cells(orgRow, "C").Value
z = Range("B" & Rows.Count).End(xlUp).Row
x = WorksheetFunction.Match(id1, Range("B1:B" & z), 0)
y = WorksheetFunction.Match(id2, Range("C" & x & ":C" & z), 0) + x - 1
For z = y To z
If Cells(z, "B").Value & vbTab & Cells(z, "C").Value <> id1 & vbTab & id2 Then Exit For
If Val(Cells(z, "D").Value) > maxSeq Then
pos = z
maxSeq = Val(Cells(z, "D").Value)
End If
Next
GetSeq.seq = maxSeq + 1
GetSeq.pos = pos
End Function
(ぶらっと)
Bunですが
現在の状態では、新規追加の枝番は常に最終の枝番の次に作られます もし、新しい枝番が既存の枝番の間に入る様にするなら以下の様に変更して下さい
Private Sub CommandButton1_Click()
Dim i As Long '★追加 2012-02-24
Dim lngRow As Long
Dim lngOffset As Long
If ComboBox10.ListIndex = -1 Or ComboBox11.ListIndex = -1 Then '★追加
Exit Sub '★追加
End If '★追加
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 '★変更 2012-02-24
For i = 0 To .ListCount - 1 '★追加 2012-02-24
If .Text < .List(i, 0) Then '★追加 2012-02-24
Exit For '★追加 2012-02-24
End If '★追加 2012-02-24
Next i '★追加 2012-02-24
lngRow = rngWork.Offset(i).Value + 1 '★追加 2012-02-24
rngList.Offset(lngRow).EntireRow.Insert
End If
End With
(Bun)
>ぶらっと様 ありがとうございます。
枝番、無事に最後に入るようになりました。
ただ別の問題が発生しました。 E列には元々 =B列&C列&D列 の結合式が入っているのを、前にいただいたコードでは、入荷実績入力時にE列に文字列として結合した値を 直接入力するようになっていました。
例 A B C D E 連番 荷受1 荷受2 枝番 入荷受付番号 1 120222 0001 01 120222000101
それが今回アップしていただいたコードで入力するとE列が指数表示になってしまいます。 入荷予定入力時はE列は結合式、実績入力後は文字列になるのでE列の書式設定は「標準」にしています。
実績入力時に結合式そのものを入れられるようになれば統一できるのですが…
Bun様にいただいたコードの中の下記の部分を参考に…と思いましたがOffsetの使い方が未だに分かっていないので どのようにすればよいかわかりませんでした。
Private Sub CommandButton1_Click()
Dim lngRow As Long
Dim lngOffset As Long
If ComboBox10.ListIndex = -1 Or ComboBox11.ListIndex = -1 Then '★追加
Exit Sub '★追加
End If '★追加
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 = ComboBox12.Text '枝番 ★変更
.Cells(lngRow, "E").Formula = "=$B" & (lngRow + lngOffset) _ '←この部分
& "&$C" & (lngRow + lngOffset) _
& "&$D" & (lngRow + lngOffset)
'List最終行位置を更新
lngRows = lngRows + 1
End If
：
End With
Bun様ありがとうございます。
今のところうまく行っています。 後出しで申し訳ございませんが、イレギュラーで入荷予定なしで入荷するものがあり、元データなしで新規でデータを追加する場合があります。 この時に新しい荷受番号を入力してデータを追加したいです。 別のフォームを作ればできますが、できるだけ同じフォームで両方入力できるようにしたいと思いまして… 新規の場合も枝番が発生することはあります。 例えばオプションボタンかコンボボックスなどで「上書」か「新規」かを選んで入力するようにはできますでしょうか？
（雪だるま）
>後出しで申し訳ございませんが、イレギュラーで入荷予定なしで入荷するものがあり、元データなしで新規でデータを追加する場合があります。 >この時に新しい荷受番号を入力してデータを追加したいです。 >別のフォームを作ればできますが、できるだけ同じフォームで両方入力できるようにしたいと思いまして… >新規の場合も枝番が発生することはあります。 >例えばオプションボタンかコンボボックスなどで「上書」か「新規」かを選んで入力するようにはできますでしょうか？
コードを詳しく調べて無いけど、多分出来ると思いますよ ただ、新規レコードを何処（List最終行の下？）に追加するのかが問題 「荷受No(1)」と「荷受No(2)」の関係と新規追加レコードの時は枝番は「00」？
(Bun)
Bun様
新規レコードはリストの最終行の下に追加です。
荷受けNo.(1)：6ケタの年月日→2012/2/24→120224 荷受けNo.(2)：4ケタの連番。その日の最初の商品から0001、0002…と振っていく 枝番：初期値は「00」。枝番が発生したら01、02…と振っていく
なので、2012/2/24でしたら 120224000100 から始まります。 その日の番号が例えば 120224000900 まで既に割り振ってあったとすれば、新規レコード追加時は 120224001000 になります。
（雪だるま）
新規レコードは最終行に追加されます 「Private Sub CommandButton1_Click()」のコードを結構変更したので プロシージャ全文をUpします
Private Sub CommandButton1_Click()
Dim i As Long '★追加 2012-02-24
Dim lngRow As Long
Dim lngOffset As Long
Dim vntData As Variant '★追加 2012-02-24 PM
lngOffset = rngWork.Row + 1 '★追加 2012-02-24 PM
If ComboBox10.ListIndex > -1 And ComboBox11.ListIndex > -1 Then '★追加 2012-02-24 PM
With ComboBox12
If .ListIndex > -1 Then
lngRow = rngWork.Offset(.ListIndex + 1).Value
Else
If MsgBox("新しい行が挿入され、新規レコードと成ります", _
vbInformation + vbOKCancel) = vbCancel Then
Exit Sub
End If
For i = 0 To .ListCount - 1 '★追加 2012-02-24
If .Text < .List(i, 0) Then '★追加 2012-02-24
Exit For '★追加 2012-02-24
End If '★追加 2012-02-24
Next i '★追加 2012-02-24
lngRow = rngWork.Offset(i).Value + 1 '★追加 2012-02-24
rngList.Offset(lngRow).EntireRow.Insert
End If
End With
Else '★追加 2012-02-24 PM
If ComboBox10.Text <> "" And ComboBox11.Text <> "" Then '★追加 2012-02-24 PM
If ComboBox12.Text = "" Then '★追加 2012-02-24 PM
ComboBox12.Text = "00" '★追加 2012-02-24 PM
End If '★追加 2012-02-24 PM
If MsgBox("新規レコードがマスタ最終行に追加されます", _
vbInformation + vbOKCancel) = vbCancel Then '★追加 2012-02-24 PM
Exit Sub '★追加 2012-02-24 PM
End If
lngRow = lngRows + 1 '★追加 2012-02-24 PM
Else '★追加 2012-02-24 PM
Exit Sub '★追加 2012-02-24 PM
End If '★追加 2012-02-24 PM
End If '★追加 2012-02-24 PM
'入荷マスタを更新
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 = ComboBox12.Text '枝番 ★変更
.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
'B列データを配列に取得
vntData = rngList.Offset(1, 1).Resize(lngRows + 1).Value '★追加 2012-02-24 PM
'B列（荷受No(1)）の重複取り、ComboBox10のListを設定
ComboBox10.List = Unique(vntData) '★追加 2012-02-24 PM
'変更が有る為再抽出
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) '★追加 2012-02-24 PM
vntData(1) = .Offset(1, 2).Value '★追加 2012-02-24 PM
Else '★追加 2012-02-24 PM
'C列から、データを配列に取得し重複を取りComboBox11のListに設定
vntData = Unique(.Offset(1, 2).Resize(lngRow).Value) '★追加 2012-02-24 PM
End If '★追加 2012-02-24 PM
'目的列から、データを配列に取得し重複を取りComboBoxのListに設定
ComboBox11.List = vntData '★追加 2012-02-24 PM
Else
ComboBox11.Clear '★追加 2012-02-24 PM
End If
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 '★追加 2012-02-24 PM
End If
End With
End Sub
(Bun)
書き忘れましたが、特にボタン等は増設していません ComboBox10、ComboBox10に新い荷受けNo.(1)、 荷受けNo.(2)を入力して、CoboBox12に枝番を入力して データ設定、CommandButtan1？を押せばマスタにこの番号が無ければ マスタの最後に追加されます
(Bun)
>それが今回アップしていただいたコードで入力するとE列が指数表示になってしまいます。 >入荷予定入力時はE列は結合式、実績入力後は文字列になるのでE列の書式設定は「標準」にしています。
文字列書式にしてもらうのが手っ取り早いんだけど、式が入る可能性もあって標準書式が必須ということなら
.Range("E1").Value = "'" & Range("B1").Value & .Range("C1").Value & .Range("D1").Value
こうかなぁ。
でも、いったん、こうして連結文字列が入ってしまったあと、このセルに式を入れても、それは 式のイメージの文字列になってしまうので注意してね。 （こういことが必要になった場合は、いったんこのセルを選択してクリア（すべて）をしてから式を入力）
(ぶらっと)
ちょっといい方式を思いついた。 E列は12桁の数字にきまっているんだと思う。 とすれば、E列の表示書式をユーザー定義で ############ と #を12個打ち込んで設定すれば 元のコードのままでも指数表示にはならないし、また、計算式も大丈夫。
(ぶらっと)
Bun様、ぶらっと様 ありがとうございます。 どちらの方法でもうまくできました。 もうしばらくテストして運用に持っていきたいと思います。 ありがとうございました。
（雪だるま）
ぶらっと様
すみません、テストしていたら、枝番を挿入する際に何故かシートの先頭行にデータが入ってしまいます… もうし遅れましたが、このシートは3行目までが見出しで4行目からがデータ行です。 以前のコードでは問題なかったのですが…
（雪だるま）
Bun様
すみません、データの最終行を取得する際に「マスター」シートのA列を基準にされているようなのですが、 A列にはあらかじめROW関数が多めに入れてあるので、B列を基準にしたく、 Private Sub CommandButton1_Click() の中の lngRow の部分をB列基準にしようとOffsetの値をいじっているのですがどうしてもA列しか参照しません… どこを変更すればB列を見るようになるでしょうか…
あと、不平を申し上げるようで大変申し訳ないのですが、チェンジイベントのせいか、最初にコンボボックスに 荷受けNoを入力する時点ですごく動作が重いです… 実際の入力速度とかなりのタイムラグがありまして… どこかを扱えば速くなるでしょうか？
（雪だるま）
>枝番を挿入する際に何故かシートの先頭行にデータが入ってしまいます
こちらで簡単なデータと、当該部分のコードを抜粋したもので動かしたけど、ちゃんと目的の場所に セットされるけどなぁ・・・・
考えられるとしたら、選択した行の B列、C列と同じ値が、タイトル行である１行目のB列、C列にあれば そうなるかもしれないけど、そんなことは無いんだよねぇ。
確かに、挿入行を求めるために、B列、C列を検索している、そのB列の検索領域をB1からにしているので それをB4からにすればいいとは思うけど。
当たるも八卦、あたらぬも八卦。
GetSeq の x = WorksheetFunction.Match(id1, Range("B1:B" & z), 0)
これを x = WorksheetFunction.Match(id1, Range("B4:B" & z), 0) + 3
こうしてみると、どうなるだろうか？
(ぶらっと)
> すみません、データの最終行を取得する際に「マスター」シートのA列を基準にされているようなのですが、 >A列にはあらかじめROW関数が多めに入れてあるので、B列を基準にしたく、 >Private Sub CommandButton1_Click() >の中の >lngRow >の部分をB列基準にしようとOffsetの値をいじっているのですがどうしてもA列しか参照しません… >どこを変更すればB列を見るようになるでしょうか…
「Private Sub CommandButton1_Click()」の中じゃないよ データの最終行を管理している変数はlngRowsと言うモジュールレベルの変数で 行取得して居るのは「Private Sub UserForm_Initialize()」の中で1度だけ行って居ます
行が新規追加された場合は、「Private Sub CommandButton1_Click()」の中で
'List最終行位置を更新
lngRows = lngRows + 1
として最終行の更新をしています 因って、B列で最終行の取得をするのは、「Private Sub UserForm_Initialize()」の中の以下の部分です
'Listの行数、列数取得
With rngList
'行数の取得
' lngRows = .Offset(Rows.Count - .Row).End(xlUp).Row - .Row
'B列で'行数の取得
lngRows = .Offset(Rows.Count - .Row, 1).End(xlUp).Row - .Row '★変更 2012-02-28
'列数の取得
★印に変更すればいいでしょう
>あと、不平を申し上げるようで大変申し訳ないのですが、チェンジイベントのせいか、最初にコンボボックスに >荷受けNoを入力する時点ですごく動作が重いです… >実際の入力速度とかなりのタイムラグがありまして… >どこかを扱えば速くなるでしょうか？
「Change」イベントだと、1文字変更する度に抽出が起こるので遅く成るのかも？ 因って、ComboBox10、ComboBox11の「Change」イベントをソックリ其のまま「Exit」イベントに変更して下さい ただ、「Private Sub ComboBox12_Change()」だけは其のままにして下さい
(Bun)
現状のコードでは各コントロールに値を読み込むのに抽出用シート（更新用）から読み込んで居るのですが？ 後で善く考えたら、抽出用シート（更新用）には「番号」、「荷受No(1)」、「荷受No(2)」、「枝番」だけ抽出し その他値は、直接「入荷マスタ」から読み込めば善いのに気が付きました そうすれば、抽出の時間が短縮されると思います
先ず、以下の3箇所のコードを変更します、変更内容は
「rngWork.Resize(, 18)」を「rngWork.Resize(, 4)」の様に18を4に変更します
1、「Private Sub ComboBox10_Exit(ByVal Cancel As MSForms.ReturnBoolean)」の中の
'AdvancedFilterを実行
' DoFilter rngList.Resize(lngRows + 1, lngColumns), rngCrit.Resize(2), rngWork.Resize(, 18)
DoFilter rngList.Resize(lngRows + 1, lngColumns), rngCrit.Resize(2), rngWork.Resize(, 4)
2、「Private Sub ComboBox11_Exit(ByVal Cancel As MSForms.ReturnBoolean)」の中の
' DoFilter rngList.Resize(lngRows + 1, lngColumns), rngCrit.Resize(2, 2), rngWork.Resize(, 18)
DoFilter rngList.Resize(lngRows + 1, lngColumns), rngCrit.Resize(2, 2), rngWork.Resize(, 4)
3、「Private Sub CommandButton1_Click()」の中の
'変更が有る為再抽出
' DoFilter rngList.Resize(lngRows + 1, lngColumns), rngCrit.Resize(2), rngWork.Resize(, 18)
DoFilter rngList.Resize(lngRows + 1, lngColumns), rngCrit.Resize(2), rngWork.Resize(, 4)
次に、各コントロールに値を読み込む「Private Sub PutControls()」を以下の様に変更します
Private Sub PutControls()
Dim lngRow As Long
With ComboBox12
If .ListIndex = -1 Then
Exit Sub
Else
' lngRow = .ListIndex + 1
lngRow = rngWork.Offset(.ListIndex + 1).Value + 1 '★変更 2012-02-27
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
'入荷マスタ指定位置因り
With rngList
OptionButton1.Value = .Cells(lngRow, "F").Value 'F列
OptionButton2.Value = .Cells(lngRow, "G").Value 'G列
ComboBox1.Value = .Cells(lngRow, "H").Value 'H列
TextBox4.Text = .Cells(lngRow, "I").Value '伝票番号
TextBox5.Text = .Cells(lngRow, "J").Value '納品日
ComboBox2.Value = .Cells(lngRow, "K").Value
ComboBox3.Value = .Cells(lngRow, "L").Value
ComboBox4.Value = .Cells(lngRow, "M").Value
ComboBox5.Value = .Cells(lngRow, "N").Value
TextBox6.Text = .Cells(lngRow, "O").Value '在庫ID
ComboBox6.Value = .Cells(lngRow, "P").Value '品名
TextBox7.Text = .Cells(lngRow, "Q").Value '入荷予定数
End With
End Sub
尚出来れば、抽出用シート（更新用）には、条件範囲のAA1、AB1の「荷受No(1)」、「荷受No(2)」と 抽出範囲としてA1、B1、C1、D1の「番号」、「荷受No(1)」、「荷受No(2)」、「枝番」4列を残して それ以外の列見出しを削除しして下さい
(Bun)
ごめん、もう一か所直すのを忘れていました
3、「Private Sub CommandButton1_Click()」の中の
'変更が有る為再抽出
' DoFilter rngList.Resize(lngRows + 1, lngColumns), rngCrit.Resize(2), rngWork.Resize(, 18)
DoFilter rngList.Resize(lngRows + 1, lngColumns), rngCrit.Resize(2), rngWork.Resize(, 4)
は2箇所に成ります（最初の修正か所の下10行目）
尚、此れはモジュール先頭で
Option Explicit
Private Const clngExtr As Long = 4 '★抽出列数
Private rngList As Range '入荷マスタの列見出し先頭セル位置 Private rngWork As Range '作業用シートの抽出範囲
として変数宣言して
rngWork.Resize(, clngExtr)
とした方が善いかも
(Bun)
ぶらっと様
ありがとうございます。 やはり先頭行にデータが追加されます… 先日テストした時は問題なく下に追加されたように思ったのですが、何故こうなったか分かりません…
Bun様
ありがとうございます。 入力の速度は速くなりました。 あと追加される行も大丈夫です。
ただ、今度は枝番を追加しようとすると
「型が一致しません」
のエラーが出てしまいます（新規レコード追加の際は問題ないのですが、枝番追加の場合のみ出ます）
Private Sub CommandButton1_Click()
の中の
lngRow = rngWork.Offset(i).Value + 1 '★追加 2012-02-24
ここが黄色く反転します。
rngWork.Offset(i)の値は「入荷ID」（恐らくA列の見出し行）になっています。
>rngWork.Resize(, clngExtr)
これは
Private Sub CommandButton1_Click()
の中の2か所いずれも
DoFilter rngList.Resize(lngRows + 1, lngColumns), rngCrit.Resize(2), rngWork.Resize(, clngExtr)
このようにした方がよいでしょうか？
（雪だるま）
>ただ、今度は枝番を追加しようとすると > >「型が一致しません」 > > >のエラーが出てしまいます（新規レコード追加の際は問題ないのですが、枝番追加の場合のみ出ます） >Private Sub CommandButton1_Click() >の中の > lngRow = rngWork.Offset(i).Value + 1 '★追加 2012-02-24 >ここが黄色く反転します。 >rngWork.Offset(i)の値は「入荷ID」（恐らくA列の見出し行）になっています。 >
ごめん、じじいなので頭が混乱して居るかも？ For～Nextを抜けた後での条件分岐を忘れていたようです
「Private Sub CommandButton1_Click()」の中で以下の様に変更して下さい
If MsgBox("新しい行が挿入され、新規レコードと成ります", _
vbInformation + vbOKCancel) = vbCancel Then
Exit Sub
End If
For i = 0 To .ListCount - 1 '★追加 2012-02-24
If .Text < .List(i, 0) Then '★追加 2012-02-24
Exit For '★追加 2012-02-24
End If '★追加 2012-02-24
Next i '★追加 2012-02-24
If i <= .ListCount - 1 Then '★追加 2012-02-29
lngRow = rngWork.Offset(i + 1).Value '★追加 2012-02-29
Else '★追加 2012-02-29
lngRow = rngWork.Offset(i).Value + 1 '★追加 2012-02-24
End If '★追加 2012-02-29
rngList.Offset(lngRow).EntireRow.Insert
End If
End With
>>rngWork.Resize(, clngExtr) >これは >Private Sub CommandButton1_Click() >の中の2か所いずれも > DoFilter rngList.Resize(lngRows + 1, lngColumns), rngCrit.Resize(2), rngWork.Resize(, clngExtr) >このようにした方がよいでしょうか？
定数に変更した方が善いと思います 本当は、最初からこうした方が善かったのですが、忘れていました この様にすれば、モジュール先頭の
Private Const clngExtr As Long = 4 '★抽出列数
の値を変更すれば、全て変更されますので今回の様にアッチコッチ直さ無くても善いので？
(Bun)
Bun様 すみません、変更しましたがまだ同じエラーが出ます… 変更は↓これでよいのですよね？
Private Sub CommandButton1_Click()
Dim i As Long '★追加 2012-02-24
Dim lngRow As Long
Dim lngOffset As Long
Dim vntData As Variant '★追加 2012-02-24 PM
lngOffset = rngWork.Row + 1 '★追加 2012-02-24 PM
If ComboBox10.ListIndex > -1 And ComboBox11.ListIndex > -1 Then '★追加 2012-02-24 PM
With ComboBox12
If .ListIndex > -1 Then
lngRow = rngWork.Offset(.ListIndex + 1).Value
Else
If MsgBox("新しい行が挿入され、新規レコードと成ります", _
vbInformation + vbOKCancel) = vbCancel Then
Exit Sub
End If
For i = 0 To .ListCount - 1 '★追加 2012-02-24
If .Text < .List(i, 0) Then '★追加 2012-02-24
Exit For '★追加 2012-02-24
End If '★追加 2012-02-24
Next i '★追加 2012-02-24
If i <= .ListCount - 1 Then '★追加 2012-02-29
lngRow = rngWork.Offset(i + 1).Value '★追加 2012-02-29
Else '★追加 2012-02-29
lngRow = rngWork.Offset(i).Value + 1 '★追加 2012-02-24
End If '★追加 2012-02-29
rngList.Offset(lngRow).EntireRow.Insert
End If
End With
Else '★追加 2012-02-24 PM
If ComboBox10.Text <> "" And ComboBox11.Text <> "" Then '★追加 2012-02-24 PM
If ComboBox12.Text = "" Then '★追加 2012-02-24 PM
ComboBox12.Text = "00" '★追加 2012-02-24 PM
End If '★追加 2012-02-24 PM
If MsgBox("新規レコードがマスタ最終行に追加されます", _
vbInformation + vbOKCancel) = vbCancel Then '★追加 2012-02-24 PM
Exit Sub '★追加 2012-02-24 PM
End If
lngRow = lngRows + 1 '★追加 2012-02-24 PM
Else '★追加 2012-02-24 PM
Exit Sub '★追加 2012-02-24 PM
End If '★追加 2012-02-24 PM
End If '★追加 2012-02-24 PM
（略）
あと、コンボボックス10・11に値を入力するとコンボボックスにその荷受けNoの枝番の一覧が表示されていたはずですが、今は何も表示されません。 Private Sub ComboBox12_Change() の部分はいじってないです。 コンボボックス10に値を入力した時点では、コンボボックス11にはその荷受けNoの一覧が表示されます。 コンボボックス12が消えてしまいました…
（雪だるま）
まず、不具合を勘違いしていたかも。 >枝番を挿入する際に何故かシートの先頭行にデータが入ってしまいます もしかして、選んだブロック（B列、C列が同じ値のブロック）の先頭に入るということ？ いずれにしても、私のコードは｢どこかの行の１つ下｣に挿入されるので シートのトップ（１行目）に入る事はありえないし、同じブロックの｢先頭｣に入る事もありえない・・ （仮にバグがあったとしても）シートの２行目に入るか、あるいはブロックの２行目として挿入される。 現に、こちらでは、問題なくセットされている。
仮に、B列が同じものが、シート上に、｢分かれて｣存在していたら、おかしな結果になる可能性はあるけど。
それと、私のコードは、｢ブロックの最終行の次の行｣に追加しているのではなく、 ｢ブロック内で最大の枝番を持つ行の次の行｣に追加している。（まぁ、問題はないかとは思うけど）
ただ、当方、｢還暦をはるか昔に迎えたじじぃ｣で、理解力が極めて悪く どこかで、根本的な勘違いをしている可能性は大きいね。 (別スレでも、このことでBunさんにご迷惑をおかけした）
いずれにしても、別途、Bunさんのコードで進んでいるようなので、そちらに注力して完成させ 私はROMに回ったほうがいいね。
(ぶらっと)
>すみません、変更しましたがまだ同じエラーが出ます… >変更は↓これでよいのですよね？
変更は善いみたいですね ただ、こちらでは出ていないみたいですね？
如何言う操作をしていますか？
>あと、コンボボックス10・11に値を入力するとコンボボックスにその荷受けNoの枝番の一覧が表示されていたはずですが、今は何も表示されません。
エラーは出て居ませんか？ 「更新用」シートをの上にUserFormを出して操作をした時、抽出されていますか？
尚、今日納期の物が在るので、コードの確認等は明日以降に成りますので宜しく
(Bun)
ぶらっと様
いえ、認識は間違いではないです。 データシートの「1行目」に入るんです。 今までぶらっと様のコードで運用していて、このような問題は出なかったのですが…
Bun様
>如何言う操作をしていますか？ コンボボックス10・11に入力済みのものと同じ荷受けNoを入力、12に新規枝番を入力、コマンドボタンを押すと 「新規レコードとして追加されます」 のメッセージが出て、OKを押すと「型が一致しません」のエラーになります。
>エラーは出て居ませんか？ はい、この時はエラーは出ません。 更新用シートでは、B～D列の荷受けNo(1),(2)列、枝番とも抽出されています。 しかし条件範囲の部分で、AA列の荷受けNo(1)は出ますがAB列の荷受けNo(2)は抽出されていないようです。
（雪だるま）
一応、頭の整理とコードの整理をして見ました 後付けで変更しているので、ComboBox10、11、12の条件分岐と行位置の取得が上手く無かった見たいですね
コード 整理を行ったのでUserFormのコードを全文Upしますので、入れ替えて下さい
Option Explicit
Private Const clngExtr As Long = 4 '★抽出列数
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 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
'B列で'行数の取得
lngRows = .Offset(Rows.Count - .Row, 1).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 = GetBList
'マッチングを行いません
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 ComboBox10_Enter()
ComboBox11.ListIndex = -1
With ComboBox12
.ListIndex = -1
.Clear
End With
ClearControls
End Sub
Private Sub ComboBox10_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim i As Long
Dim vntData As Variant
Dim lngRow As Long
If ComboBox10.Text = "" Then
Exit Sub
End If
'重複を取った「荷受No(2)」のデータを取得
vntData = GetComboList(ComboBox10.Text, 1, lngRow)
With ComboBox11
'抽出行数が0で無いなら
If lngRow > 0 Then
'ComboBox11にListを設定
.List = vntData
Else
'ComboBox11と各コントロールをクリア
.Clear
ClearControls
End If
End With
End Sub
Private Sub ComboBox11_Enter()
ComboBox12.ListIndex = -1
ClearControls
End Sub
Private Sub ComboBox11_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim i As Long
Dim lngRow As Long
Dim vntData As Variant
If ComboBox11.Text = "" Then
Exit Sub
End If
'重複を取った「枝番」のデータを取得
vntData = GetComboList(ComboBox11.Text, 2, lngRow)
With ComboBox12
'抽出行数が0で無いなら
If lngRow > 0 Then
'ComboBox12にListを設定
.List = vntData
'ComboBox12のList最終を選択
.ListIndex = .ListCount - 1
Else
'ComboBox12と各コントロールをクリア
.Clear
ClearControls
End If
End With
End Sub
Private Sub ComboBox12_Change()
With ComboBox12
If .ListIndex = -1 Then
Exit Sub
Else
GetLitData rngWork.Offset(.ListIndex + 1).Value
End If
End With
End Sub
Private Sub ComboBox12_Exit(ByVal Cancel As MSForms.ReturnBoolean)
With ComboBox12
If .Text = "" Then
.Text = Right("00" & .Text, 2)
End If
End With
End Sub
Private Sub CommandButton1_Click()
Dim i As Long
Dim lngRow As Long
Dim lngOffset As Long
Dim vntData As Variant
'ComboBox10、ComboBox11のTextBox部に入力が無い場合
If ComboBox10.Text = "" Or ComboBox11.Text = "" Then
Exit Sub
End If
'データの更新位置を取得
lngRow = GetCurrentRow
'更新を許可しない場合
If lngRow = 0 Then
Exit Sub
End If
'入荷マスタを更新
PutLitData lngRow
'ComboBox10のListを設定、B列（荷受No(1)）の重複取り
ComboBox10.List = GetBList
'B列（荷受No(2)）の値取得
vntData = GetComboList(ComboBox10.Text, 1, lngRow)
With ComboBox11
'列見出し以上の行が在るなら
If lngRow > 0 Then
'ComboBoxのListを設定
ComboBox11.List = vntData
Else
ComboBox11.Clear
End If
End With
'C列（枝番）の値取得と最終データを各コントロールに取得
vntData = GetComboList(ComboBox11.Text, 2, lngRow)
With ComboBox12
'列見出し以上の行が在るなら
If lngRow > 0 Then
'ComboBoxのListを設定
ComboBox12.List = vntData
Else
ComboBox12.Clear
End If
'各コントロールにデータを読み込み
GetLitData rngWork.Offset(.ListIndex + 1).Value
End With
End Sub
Private Function GetCurrentRow() As Long
Dim i As Long
Dim lngRow As Long
Dim lngOffset As Long
Dim vntData As Variant
ComboBox12.Text = Right("00" & ComboBox12.Text, 2)
If ComboBox10.ListIndex > -1 And ComboBox11.ListIndex > -1 Then
With ComboBox12
'マスタListに既存のデータが在る場合
If .ListIndex > -1 Then
'抽出ListのComboBox12で選択されている行の先頭データ+1がrngListの行Offseを示す
'ComboBox12のListIndex+1はrngWorkの行Offset
lngRow = rngWork.Offset(.ListIndex + 1).Value
Else
If MsgBox("新しい行が挿入され、新規レコードと成ります", _
vbInformation + vbOKCancel) = vbCancel Then
Exit Function
End If
'ComboBox12のListを上から見て行って
For i = 0 To .ListCount - 1
'Listの値がTextBox部の値より大きく成ったら
If .List(i, 0) > .Text Then
Exit For
End If
Next i
'TextBox部の値がList最終値以内なら
If i <= .ListCount - 1 Then
'挿入行(マスタの行)位置をListの値がTextBox部の値より大きく成った位置とする
lngRow = rngWork.Offset(i + 1).Value
Else
'Listの最終値よりTextBox部が大きい場合、List最終行の先頭セル値+1とする
lngRow = rngWork.Offset(i).Value + 1
End If
'マスタの指定位置に行を挿入
rngList.Offset(lngRow).EntireRow.Insert
'マスタ最終行位置を更新
lngRows = lngRows + 1
End If
End With
Else
'「荷受No(1)」が新規なら
If ComboBox10.ListIndex = -1 Then
If MsgBox("新規レコードがマスタ最終行に追加されます", _
vbInformation + vbOKCancel) = vbCancel Then
Exit Function
End If
'マスタ最終行位置を更新
lngRows = lngRows + 1
lngRow = lngRows
Else
'「荷受No(2)」が新規なら
If ComboBox11.ListIndex = -1 Then
If MsgBox("新しい行が挿入され、新規レコードと成ります", _
vbInformation + vbOKCancel) = vbCancel Then
Exit Function
End If
'重複を取った「荷受No(2)」のデータを取得
vntData = GetComboList(ComboBox10.Text, 1, lngRow)
'C列からデータを配列に取得
vntData = rngWork.Offset(1, 2).Resize(lngRow + 1).Value
'C列のデータを上から見て行って
For i = 1 To UBound(vntData, 1) - 1
'C列の値がTextBox部の値より大きく成ったら
If vntData(i, 1) > ComboBox11.Text Then
Exit For
End If
Next i
'TextBox部の値がList最終値以内なら
If i <= UBound(vntData, 1) - 1 Then
'挿入行(マスタの行)位置をC列の値がTextBox部の値より大きく成った位置とする
lngRow = rngWork.Offset(i).Value
Else
'C列の最終値よりTextBox部が大きい場合、C列最終行の先頭セル値+1とする
lngRow = rngWork.Offset(i - 1).Value + 1
End If
'マスタの指定位置に行を挿入
rngList.Offset(lngRow).EntireRow.Insert
'マスタ最終行位置を更新
lngRows = lngRows + 1
End If
End If
End If
GetCurrentRow = lngRow
End Function
Private Function GetBList() As Variant
Dim vntData As Variant
'B列データを配列に取得
vntData = rngList.Offset(1, 1).Resize(lngRows + 1).Value
'B列（荷受No(1)）の重複取り、戻り値とする
GetBList = Unique(vntData)
End Function
Private Function GetComboList(vntCrit As Variant, lngNum As Long, lngRow As Long) As Variant
Dim i As Long
Dim vntData As Variant
'条件範囲にComboBoxの値を代入（式の形で）
rngCrit.Offset(1, lngNum - 1).Value = "=""" & vntCrit & """"
'AdvancedFilterを実行
DoFilter rngList.Resize(lngRows + 1, lngColumns), _
rngCrit.Resize(2, lngNum), _
rngWork.Resize(, clngExtr)
'抽出範囲から
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, lngNum + 1).Value
Else
'C列から、データを配列に取得し重複を取りComboBox11のListに設定
vntData = Unique(.Offset(1, lngNum + 1).Resize(lngRow).Value)
End If
'目的列から、データを配列に取得し重複を取りComboBoxのListに設定
GetComboList = 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
'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 GetLitData(lngOffset As Long)
Dim lngRow As Long
'行Offsetを行位置に変換
lngRow = lngOffset + 1
'入荷マスタ指定位置因り
With rngList
OptionButton1.Value = .Cells(lngRow, "F").Value 'F列
OptionButton2.Value = .Cells(lngRow, "G").Value 'G列
ComboBox1.Value = .Cells(lngRow, "H").Value 'H列
TextBox4.Text = .Cells(lngRow, "I").Value '伝票番号
TextBox5.Text = .Cells(lngRow, "J").Value '納品日
ComboBox2.Value = .Cells(lngRow, "K").Value
ComboBox3.Value = .Cells(lngRow, "L").Value
ComboBox4.Value = .Cells(lngRow, "M").Value
ComboBox5.Value = .Cells(lngRow, "N").Value
TextBox6.Text = .Cells(lngRow, "O").Value '在庫ID
ComboBox6.Value = .Cells(lngRow, "P").Value '品名
TextBox7.Text = .Cells(lngRow, "Q").Value '入荷予定数
End With
End Sub
Private Sub PutLitData(lngOffset As Long)
Dim lngGap As Long
Dim lngRow As Long
'マスタの行Offsetと絶対行位置の差分を取得
lngGap = rngList.Row - 1
'行Offsetを行位置に変換
lngRow = lngOffset + 1
'入荷マスタを更新
With rngList
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 = ComboBox12.Text '枝番
.Cells(lngRow, "E").Formula = "=$B" & (lngRow + lngGap) _
& "&$C" & (lngRow + lngGap) _
& "&$D" & (lngRow + lngGap)
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
End Sub
(Bun)
Bun様
お礼が遅くなり申し訳ございません。
今度は大丈夫でした。
ただ、「新規データは最終行の次に追加される」とのことでしたが、
荷受No(1) 荷受No(2) 枝番 120307 0012 00 120308 0001 00 ： ： ： 120308 0010 09 120307 0013 00 120307 0014 00
このように荷受No(1)が前後している時に、「120308 0011 00」のデータを追加すると
荷受No(1) 荷受No(2) 枝番 120307 0012 00 120308 0001 00 ： ： ： 120308 0010 09 120308 0011 00 ←☆ここ 120307 0013 00 120307 0014 00
上記のように、最終行ではなく同じ荷受Noの最終行のところに追加されます。
できれば
荷受No(1) 荷受No(2) 枝番 120307 0012 00 120308 0001 00 ： ： ： 120308 0010 09 120307 0013 00 120307 0014 00 120308 0011 00 ←☆ここ
このようにしたいのですが… （荷受けNoは基本的に日付順ですが、イレギュラー入荷などで日付が前後することが多々あります）
何度も申し訳ありません
（雪だるま）
以下の★印の行（コメントも）を削除してインデントを直せば善いと思います
Private Function GetCurrentRow() As Long
Dim i As Long
Dim lngRow As Long
Dim lngOffset As Long
Dim vntData As Variant
ComboBox12.Text = Right("00" & ComboBox12.Text, 2)
If ComboBox10.ListIndex > -1 And ComboBox11.ListIndex > -1 Then
With ComboBox12
'マスタListに既存のデータが在る場合
If .ListIndex > -1 Then
'抽出ListのComboBox12で選択されている行の先頭データ+1がrngListの行Offseを示す
'ComboBox12のListIndex+1はrngWorkの行Offset
lngRow = rngWork.Offset(.ListIndex + 1).Value
Else
If MsgBox("新しい行が挿入され、新規レコードと成ります", _
vbInformation + vbOKCancel) = vbCancel Then
Exit Function
End If
'ComboBox12のListを上から見て行って
For i = 0 To .ListCount - 1
'Listの値がTextBox部の値より大きく成ったら
If .List(i, 0) > .Text Then
Exit For
End If
Next i
'TextBox部の値がList最終値以内なら
If i <= .ListCount - 1 Then
'挿入行(マスタの行)位置をListの値がTextBox部の値より大きく成った位置とする
lngRow = rngWork.Offset(i + 1).Value
Else
'Listの最終値よりTextBox部が大きい場合、List最終行の先頭セル値+1とする
lngRow = rngWork.Offset(i).Value + 1
End If
'マスタの指定位置に行を挿入
rngList.Offset(lngRow).EntireRow.Insert
'マスタ最終行位置を更新
lngRows = lngRows + 1
End If
End With
Else
'「荷受No(1)」が新規なら
' If ComboBox10.ListIndex = -1 Then '★削除
If MsgBox("新規レコードがマスタ最終行に追加されます", _
vbInformation + vbOKCancel) = vbCancel Then
Exit Function
End If
'マスタ最終行位置を更新
lngRows = lngRows + 1
lngRow = lngRows
' Else '★削除
' '「荷受No(2)」が新規なら
' If ComboBox11.ListIndex = -1 Then '★削除
' If MsgBox("新しい行が挿入され、新規レコードと成ります", _
' vbInformation + vbOKCancel) = vbCancel Then '★削除
' Exit Function '★削除
' End If '★削除
' '重複を取った「荷受No(2)」のデータを取得
' vntData = GetComboList(ComboBox10.Text, 1, lngRow) '★削除
' 'C列からデータを配列に取得
' vntData = rngWork.Offset(1, 2).Resize(lngRow + 1).Value '★削除
' 'C列のデータを上から見て行って
' For i = 1 To UBound(vntData, 1) - 1 '★削除
' 'C列の値がTextBox部の値より大きく成ったら
' If vntData(i, 1) > ComboBox11.Text Then '★削除
' Exit For '★削除
' End If '★削除
' Next i '★削除
' 'TextBox部の値がList最終値以内なら
' If i <= UBound(vntData, 1) - 1 Then '★削除
' '挿入行(マスタの行)位置をC列の値がTextBox部の値より大きく成った位置とする
' lngRow = rngWork.Offset(i).Value '★削除
' Else '★削除
' 'C列の最終値よりTextBox部が大きい場合、C列最終行の先頭セル値+1とする
' lngRow = rngWork.Offset(i - 1).Value + 1 '★削除
' End If '★削除
' 'マスタの指定位置に行を挿入
' rngList.Offset(lngRow).EntireRow.Insert '★削除
' 'マスタ最終行位置を更新
' lngRows = lngRows + 1 '★削除
' End If '★削除
' End If '★削除
End If
GetCurrentRow = lngRow
End Function
(Bun)
（雪だるま）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.