Results of 1 - 1 of about 37667 for IF (0.007 sec.)
- [[20120222152309]]
- #score: 1591
- @digest: 10786def033886b7352460704e13b439
- @id: 57848
- @mdate: 2012-03-09T02:03:49Z
- @size: 69811
- @type: text/plain
- #keywords: 加20 (388749), 荷受 (321015), 受no (253799), combobox12 (237834), orgrow (221713), rngwork (212737), lngrow (177091), lngoffset (153568), combobox10 (126831), combobox11 (121492), 規レ (87136), 枝番 (80142), vntdata (76787), rngcrit (76670), lngrows (68157), dofilter (62289), rnglist (53807), 除' (48991), lngcolumns (43451), listindex (34767), 荷予 (32898), 入荷 (32783), optionbutton2 (26043), optionbutton1 (23478), 2012 (22665), マス (17953), 追加 (14571), レコ (13623), value (13295), textbox (12978), 行位 (11919), list (11378)
- 『入荷データ入力時の枝番生成（2）
』（雪だるま） [[20120111115844]] 上記の質問で入荷マスターにデータを登録する際に枝番を生成する方法を教えていただきました。 ぶらっと様、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 '★ リスト以外のデータ入力OK .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 '荷受1 TextBox2.Value = Cells(orgRow, "C").Value '荷受2 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様 データは表示できるようになりましたが、入荷予定として既に入力されているデータを選択して 入荷実数を入力→登録するとそれが新しいデータとして登録されてしまいます… 前トピでも説明不足でご迷惑をおかけしたのですが、 >このユーザーフォームは「枝番生成」が前提ではなく、 >@ 入荷予定入力されたデータに、実際に入荷した時に数量などの詳細データを入力したい。 >A @の過程で「場合によっては」枝番生成の必要が出てくるので、その場合は元の行をコピーして枝番をつけたデータを追加したい。 なので毎回新規データを登録するわけではないのです… （雪だるま） ---- >これは新しい枝番は自分で入力して登録するようになっているのですね。 はい其の通りです、何故なら枝番が連続している物か解らないので勝手枝番を振らない方がいいだろうと 言う観点から振っていません ただ、枝番の最終番号はComboBox12のプルダウンを見れば解りますので（プルダウンの最終行が最終番号） その次の番号をComboBox12に手入力すれば善いと思いますが? >データは表示できるようになりましたが、入荷予定として既に入力されているデータを選択して >入荷実数を入力→登録するとそれが新しいデータとして登録されてしまいます… >前トピでも説明不足でご迷惑をおかけしたのですが、 > >>このユーザーフォームは「枝番生成」が前提ではなく、 > >>@ 入荷予定入力されたデータに、実際に入荷した時に数量などの詳細データを入力したい。 >>A @の過程で「場合によっては」枝番生成の必要が出てくるので、その場合は元の行をコピーして枝番をつけたデータを追加したい。 いえ、このUserFormは既存データの修正更新が目的で、その中に枝番生成も含まれています 詰まり、上記@Aをコーディングした積りです ただ、後で幾つか不都合が有ったのですが?、ぶらっとさんのコードを使う様だったので其れは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) _ 多分これで修正出来ると思います 上記修正を終われば >A @の過程で「場合によっては」枝番生成の必要が出てくるので、その場合は元の行をコピーして枝番をつけたデータを追加したい。 此れを行うなら、先ずComboBox12でコピーしたい枝番を選択します 選択が終われば、各コントロールにデータが呼び出されますので 修正する所を直し、ComboBox12のTextBox部に新しい枝番を入力し、CommandButtonを押します そうすれば、新規レコードが追加されます （枝番ComboBox12の値を先に変更してデータを変更でもOK） 既存データの変更修正の場合も同様に変更したい、枝番をComboBox12で選択して データを変更修正してComboBox12の値を変更せずCommandButton押せば、選択されているレコードに上書されます (Bun) ---- 自信度は55%ぐらいだけど・・・ 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 という並びになります。 できれば枝番の順番に並べたいのですが… （雪だるま） ---- テスト環境を準備しておらず、目視でのデバッグだけなので自信度45% ・ユーザーフォームモジュールの最初、宣言部に以下 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列と同じ値が、タイトル行である1行目の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列が同じ値のブロック）の先頭に入るということ? いずれにしても、私のコードは「どこかの行の1つ下」に挿入されるので シートのトップ（1行目）に入る事はありえないし、同じブロックの「先頭」に入る事もありえない・・ （仮にバグがあったとしても）シートの2行目に入るか、あるいはブロックの2行目として挿入される。 現に、こちらでは、問題なくセットされている。 仮に、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) ---- Bun様ありがとうございます。 できました。助かりました! （雪だるま）
... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201202/20120222152309.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97012 documents and 608132 words.
訪問者：