[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ユーザーフォームの転記がうまくいきません３』（peridot）
の続きです。
>つまり、アップされた例で言うと、作業簿_SK に対する単価マスタは、３行目から１７行目までの１５行。 >で、「余裕をみて？」１８行用意したということを言っているのかな？
はい、その通りです。
>仮に、単価マスタに作業簿_SKに関して、SKが１０行、SXが３行、SWが２行登録されていたとする。 >ユーザーフォームの各行のラベルは、どうなると想定している？（SKが何行、SXが何行、SWが何行？？）
想定としては、上記の場合だとSKが10行、SXが3行、SWが2行で計15行表示と思っています。 「枝番」混在で入力することはないので（枝番「1」の時は「1」しか入力しない）、枝番ごとに 入力画面は別になると想定しています。
>準備したコードでは、この場合、あらかじめデザインされた１８行のうち、上の１５行だけを表示、 >下の５行は非表示にして、ラベルは上から、SKが１０行、SXが３行、SWが２行 となる。 >こうせざるを得ないのは理解してくれるかな？
はい、了解いたしました。
>なので、一度に、１５行までしか入力（登録）できないので、１６行以上ある場合は、２回に分けてということになる。 >なお、フォーム表示はモーダルでもモードレスでも、どちらでもＯＫにしておいた。
了解いたしました。ありがとうございます。
完成度は、まだ６０％ぐらいだと思うけど、とりあえずコードをアップする。 まずは、動きを確認して欲しい。（要件の取り間違えは多いと思うし、エラー頻発かもしれない。）
その前に、準備手順を以下、メモ。
１．cbx_Cls と cbx_No は MatchRequired を True にして。
２．cbx_Cls 、 cbx_No、txt_Date、CommandButton1 「以外」は Visible を False に、Enabled も False にして。
３．CommandButton2、CommandButton3 の TakeFocusOnClick は False にして。
４．以下のコードを、それぞれのモジュールにか貼付けるわけだけど、その際に、クラスモジュールがある。
ＶＢＥ画面で「挿入」の「クラスモジュール」とやると、「Class1」という名前のモジュールができる。
このままでもいいんだけど、コードの中で、このクラスモジュールを「clsLine」という名前で利用しているので
この時の画面の左の下半分のプロパティウィンドウのオブジェクト名を「clsLine」に変更してほしい。
５．で、このクラスモジュールに、以下のクラスモジュールコードをコピペすると、
'Attribute txtQty_BeforeUpdate.VB_UserMemId = &H80018201 このコードが最終的にはこのプロシジャに埋め込まれる
Attribute txtQty_BeforeUpdate.VB_UserMemId = &H80018201
この、２番目のコードが構文エラーで赤く光る。びっくりしないで、
・左上のプロジェクトエクスプローラの clsLine を右クリックして、解放を選ぶ。
エクスポートするかどうかを聞いてくるので「はい。（エクスポートする）」を選ぶ。
・で、メニューの「ファイル」->「インポート」で、でてくるダイアログの中から、今、エクスポートした
「clsLine.cls」を選んで、「開く」をおす。これで、また、クラスモジュールが入ってくる。
ここでは、先ほど赤く光ったコードはきえている。（実は、プロシジャの中に埋め込まれている）
★詳しいことについては、必要であれば、おいおいに。まずは、コードが動くようになることを目指そう。
６．で、このブックを、いったん保存して閉じ、あらためて開くと、マクロが動く環境が整う。
（ThisWorkbook モジュール）
Option Explicit
Private Sub Workbook_Open()
Call Preparation
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call CleanUp
End Sub
（標準モジュール）
Option Explicit
'各モジュールで共通して使うPublic変数
Public dic As Object 'コンボボックスのリスト情報 Public dicLine As Object '単価マスタ上の分類コードごとの行数 Public dicSample As Object '箱サンプルシートに関する情報 Public dicQty As Object '箱サンプルシートの分類・記号（枝番付き）別の数量 Public lineClct As Collection 'ユーザーフォームの行毎のクラス保持用コレクション Public maxCodeLines As Long Public FormLines As Long Public skipEvent As Boolean
Sub Preparation() 'Workbook_Open での処理
Set dic = CreateObject("Scripting.Dictionary")
Set dicLine = CreateObject("Scripting.Dictionary")
Set dicSample = CreateObject("Scripting.Dictionary")
Set dicQty = CreateObject("Scripting.Dictionary")
Set lineClct = New Collection
Call getSample '箱サンプルからの情報の取得
Call GetPriceList '単価マスタからの情報の取得
End Sub
Sub getSample() '箱サンプルからのデータ取り込み
Dim w As Variant
Dim f As Long
Dim e As Long
Dim s As String
Dim c As Range
Dim myCls As String
dicSample.RemoveAll
dicQty.RemoveAll
With Sheets("箱サンプル")
For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
Select Case c.Value
Case "記号"
If f <> 0 Then
e = c.Offset(-3).Row
dicSample(myCls & 0) = Array(f, e)
End If
myCls = c.Offset(-1).Value
f = c.Offset(1).Row
Case "データ行終了"
e = c.Offset(-2).Row
dicSample(myCls & 0) = Array(f, e)
Case Else
If Len(c.Value) > 0 Then
dicQty(myCls & vbTab & c.Value & vbTab & c.Offset(, 1).Value) = c.Offset(, 2).Value
End If
If Len(c.Offset(, 4).Value) > 0 Then
dicQty(myCls & vbTab & c.Offset(, 4).Value & vbTab & c.Offset(, 5).Value) = c.Offset(, 6).Value
End If
End Select
Next
For Each w In dicSample
If Right(w, 1) = "0" Then
f = dicSample(w)(0)
e = dicSample(w)(1)
s = w
Mid(s, Len(s)) = 1
dicSample(s) = .Range(.Cells(f, "A"), .Cells(e, "C")).Value
s = w
Mid(s, Len(s)) = 2
dicSample(s) = .Range(.Cells(f, "E"), .Cells(e, "G")).Value
End If
Next
End With
End Sub
Private Sub GetPriceList()
Dim c As Range
Dim myCode As String
Dim myCls As String
Dim myMedia As String
Dim w As Variant
Dim ww As Long
With Sheets("単価マスタ")
For Each c In .Range("B3", .Range("B" & .Rows.Count).End(xlUp))
With c.EntireRow
myCode = .Range("B1").Value
myCls = .Range("J1").Value
myMedia = .Range("C1").Value
End With
If dicSample.exists(myCls & 0) Then
dicLine(myCls & 0) = dicLine(myCls & 0) + 1
dicLine(myCls & dicLine(myCls & 0)) = myCode
If Not dic.exists(myCls) Then Set dic(myCls) = CreateObject("Scripting.Dictionary")
If Not dic(myCls).exists(myCode) Then
Set dic(myCls)(myCode) = CreateObject("Scripting.Dictionary")
dic(myCls)(myCode)("") = True '媒体リストの先頭行に空白メンバを
End If
dic(myCls)(myCode)(myMedia) = True
End If
Next
End With
For Each w In dicLine
ww = Val(StrReverse(w))
If ww = 0 Then
If dicLine(w) > maxCodeLines Then maxCodeLines = dicLine(w)
End If
Next
End Sub
Sub CleanUp() 'Workbook_BeforeClose での処理
Set dic = Nothing
Set dicLine = Nothing
Set dicSample = Nothing
Set dicQty = Nothing
Set lineClct = Nothing
End Sub
'txtQty_n の BeforeUpdated イベント
Sub QtyUpdated(txtQty As MSForms.TextBox)
If skipEvent Then Exit Sub
If Len(txtQty.Value) > 0 Then
If Not IsNumeric(txtQty.Value) Then
Application.OnTime Now(), "'BackFocus """ & txtQty.Name & """'"
End If
End If
End Sub
Sub BackFocus(tbn As String) '数量入力エラー時の処理
MsgBox "数量入力が正しくありません"
With UserForm1.Controls(tbn)
.SetFocus
.SelStart = 0
.SelLength = Len(.Value)
End With
End Sub
'cbxMedia_n の Changeイベント
Sub MediaSelected(cbxMedia As MSForms.ComboBox)
Dim i As Long
Dim idx As Long
Dim dicA As Object
Dim dicB As Object
Dim d As Variant
Dim myCls As String
Dim myCode As String
Dim myMedia As String
Dim myNo As String
Dim dKey As String
If skipEvent Then Exit Sub
With UserForm1
skipEvent = True
Set dicA = CreateObject("Scripting.Dictionary")
Set dicB = CreateObject("Scripting.Dictionary")
myCls = .cbx_Cls.Value
myNo = .Controls("cbx_No").Value
myMedia = cbxMedia.Value
idx = Split(cbxMedia.Name, "_")(1)
myCode = .Controls("lblCode_" & idx).Caption
dKey = myCls & vbTab & myCode & myNo & vbTab & myMedia
If dicQty.exists(dKey) Then .Controls("txtQty_" & idx).Value = dicQty(dKey)
For i = 1 To FormLines
myMedia = .Controls("cbxMedia_" & i).Value
If .Controls("lblCode_" & i).Visible And .Controls("lblCode_" & i).Caption = myCode Then dicA(myMedia) = True
Next
For Each d In dic(myCls)(myCode)
If Len(d) = 0 Or Not dicA.exists(d) Then dicB(d) = True
Next
For i = 1 To FormLines
myCode = .Controls("lblcode_" & i).Caption
myMedia = .Controls("cbxMedia_" & i).Value
If .Controls("lblCode_" & i).Visible And .Controls("lblCode_" & i).Caption = myCode Then .Controls("cbxMedia_" & i).List = dicB.keys
Next
skipEvent = False
Set dicA = Nothing
Set dicB = Nothing
End With
End Sub
（ユーザーフォームモジュール）
Option Explicit
Private Sub UserForm_Initialize()
Dim cls As clsLine
Dim e As MSForms.Control
Dim myCtrl As Object
Dim i As Long
FormLines = 0
For Each myCtrl In Me.Controls
Debug.Print myCtrl.Name
If myCtrl.Name Like "lblCode_*" Then
FormLines = FormLines + 1
Set cls = New clsLine
lineClct.Add cls
i = Split(myCtrl.Name, "_")(1)
cls.SetCombo Me.Controls("cbxMedia_" & i)
Set cls.txtQty = Me.Controls("txtQty_" & i)
Set cls = Nothing
End If
Next
skipEvent = True
cbx_Cls.Clear
cbx_Cls.List = dic.keys
skipEvent = False
End Sub
Private Sub UserForm_Activate()
If FormLines < maxCodeLines Then
MsgBox "フォーム上の行数が十分ではないので処理ができません" & vbLf & _
"管理者に連絡してください"
Unload Me
End If
End Sub
Private Sub cbx_Cls_Change()
Dim w As Variant
Dim z As Long
Dim myCls As String
Dim myCode As String
Dim i As Long
If skipEvent Or cbx_Cls.ListIndex < 0 Then Exit Sub
cbx_No.Enabled = True
With CommandButton1
.Visible = True
.Enabled = False
End With
With CommandButton2
.Visible = True
.Enabled = False
End With
skipEvent = True
cbx_No.Value = Empty
skipEvent = False
myCls = cbx_Cls.Value
z = dicLine(myCls & 0)
LineSet
End Sub
Private Sub cbx_No_Change()
Dim i As Long
Dim myCls As String
Dim myCode As String
Dim myMedeia As String
Dim myNo As String
If skipEvent Then Exit Sub
myCls = cbx_Cls.Value
myNo = cbx_No.Value
With CommandButton1
.Visible = True
.Enabled = True
End With
With CommandButton2
.Visible = True
.Enabled = True
End With
Call LineEnable
End Sub
Private Sub CommandButton1_Click() '転記
Dim f As Long
Dim x As Long, y As Long
Dim myCls As String, myCode As String, myMedia As String, myQty As String
Dim myNo As String
Dim i As Long
Dim ctrl As Object
Dim w As String
Dim myDate As String
Dim v As Variant
Dim okFlag As Boolean
Dim strCol As String
myCls = cbx_Cls.Value
myNo = cbx_No.Value
myDate = txt_Date.Value
If Not IsDate(myDate) Then
MsgBox "日付を正しく入れてください"
Exit Sub
End If
If Len(myCls) = 0 Or Len(myNo) = 0 Then
MsgBox "分類、枝番 のいずれかが選択されていません"
Exit Sub
End If
If myNo Mod 2 = 0 Then
i = 2
strCol = "E"
Else
i = 1
strCol = "A"
End If
v = dicSample(myCls & i)
For i = 1 To FormLines
If Me.Controls("lblCode_" & i).Visible Then
myMedia = Me.Controls("cbxMedia_" & i).Value
myCode = Me.Controls("lblCode_" & i).Caption
myQty = Me.Controls("txtQty_" & i).Value
If Len(myMedia) > 0 And Len(myQty) > 0 Then
okFlag = False
For x = LBound(v, 1) To UBound(v, 1)
If v(x, 1) = myCode & myNo And v(x, 2) = myMedia Or Len(v(x, 1)) = 0 Then
v(x, 1) = myCode & myNo
v(x, 2) = myMedia
v(x, 3) = myQty
okFlag = True
Exit For
End If
Next
If Not okFlag Then
MsgBox "シートに以下のデータを書き込む余裕がありません" & vbLf & _
myCode & myNo & "/" & myMedia & "/" & myQty
End If
End If
End If
Next
w = myCls & 0
f = dicSample(w)(0)
With Sheets("箱サンプル")
.Range("F1").Value = txt_Date.Value
.Cells(f, strCol).Resize(UBound(v, 1), UBound(v, 2)).Value = v
End With
Call LineClear
MsgBox "箱サンプルへの書き込みが完了しました"
End Sub
Private Sub CommandButton2_Click() 'クリア
Call LineClear
End Sub
Private Sub CommandButton3_Click() '終了
skipEvent = True
Unload Me
End Sub
Private Sub LineSet()
Dim x As Long
Dim z As Long
Dim myCls As String
Dim myCode As String
skipEvent = True
myCls = cbx_Cls.Value
z = dicLine(myCls & 0)
For x = 1 To FormLines
If x > z Then
Me.Controls("lblCode_" & x).Visible = False
Me.Controls("cbxMedia_" & x).Visible = False
Me.Controls("txtQty_" & x).Visible = False
Else
myCode = dicLine(myCls & x)
With Me.Controls("lblCode_" & x)
.Visible = True
.Enabled = False
.Caption = myCode
End With
With Me.Controls("cbxMedia_" & x)
.Visible = True
.Enabled = False
.List = dic(myCls)(myCode).keys
.Value = Empty
End With
With Me.Controls("txtQty_" & x)
.Visible = True
.Enabled = False
.Value = Empty
End With
End If
Next
skipEvent = False
End Sub
Private Sub LineEnable()
Dim x As Long
Dim z As Long
Dim myCls As String
skipEvent = True
myCls = cbx_Cls.Value
z = dicLine(myCls & 0)
For x = 1 To FormLines
If x <= z Then
Me.Controls("lblCode_" & x).Enabled = True
Me.Controls("cbxMedia_" & x).Enabled = True
Me.Controls("txtQty_" & x).Enabled = True
End If
Next
skipEvent = False
End Sub
Private Sub LineClear()
Dim i As Long
skipEvent = True
With cbx_No
.Value = Empty
.Enabled = False
End With
For i = 1 To FormLines
With Me.Controls("lblCode_" & i)
.Caption = Empty
.Visible = False
End With
With Me.Controls("cbxMedia_" & i)
.Value = Empty
.Clear
.Visible = False
End With
With Me.Controls("txtQty_" & i)
.Value = Empty
.Visible = False
End With
Next
txt_Date.Value = Empty
cbx_Cls.Value = Empty
With CommandButton1
.Visible = True
.Enabled = False
End With
With CommandButton2
.Visible = True
.Enabled = False
End With
skipEvent = False
End Sub
（クラスモジュール）
Option Explicit
Dim WithEvents cbxMedia As MSForms.ComboBox
Private Declare Function ConnectToConnectionPoint& _
Lib "shlwapi" Alias "#168" _
(ByVal punk&, ByVal riidEvent&, ByVal fConnect&, _
ByVal punkTarget&, ByVal pdwCookie&, ByVal ppcpOut&)
Private mCookie&
Private mCtl As MSForms.TextBox
Private Sub Class_Terminate()
If mCookie = 0 Then Exit Sub
ConnectEvent False
mCookie = 0
End Sub
Property Set txtQty(ByVal m As MSForms.TextBox)
Set mCtl = m
ConnectEvent True
End Property
Property Get txtQty() As MSForms.TextBox
Set txtQty = mCtl
End Property
Sub SetCombo(cb As MSForms.ComboBox)
Set cbxMedia = cb
End Sub
Private Sub ConnectEvent(ByVal f As Boolean)
Dim iid&(3)
'IID_IDispatch
iid(0) = &H20400
iid(2) = &HC0
iid(3) = &H46000000
ConnectToConnectionPoint ObjPtr(Me), _
VarPtr(iid(0)), f, ObjPtr(mCtl), VarPtr(mCookie), 0&
End Sub
Private Sub cbxMedia_Change() 'cbxMedia_n のChangeイベント
Call MediaSelected(cbxMedia)
End Sub
Public Sub txtQty_BeforeUpdate(ByVal Cancel As ReturnBoolean) 'txtQty_n のBeforeUpdateイベント
'Attribute txtQty_BeforeUpdate.VB_UserMemId = &H80018201 このコードが最終的にはこのプロシジャに埋め込まれる
Attribute txtQty_BeforeUpdate.VB_UserMemId = &H80018201
Call QtyUpdated(txtQty)
End Sub
(ぶらっと)
(ぶらっと)様
ありがとうございます。
…いきなりつまづきました… ユーザーフォームを表示したところ、「分類」（cbx_Cls）で何も表示されません…
コントロールのプロパティやクラスモジュールの設定は書かれたとおりにしました。
単価マスタのが、2行目が見出しで3行目からデータなので
myCode = .Range("B2").Value
myCls = .Range("J2").Value
myMedia = .Range("C2").Value
このようにしてみましたがダメでした…
シート名なども確認しました。 A51には「データ行終了」と入れています。
どこがいけないんでしょう…
(peridot)
指摘のコードは、With c.EntireRow をうけているので、B1,J1,C1 にもどして。
とくに説明はしなかったけど、対象の分類は、箱サンプルシートから抽出してきている。 ここになければ、単価マスタにあっても対象外にしている。箱サンプルシートにないものを 仮にあつかったとしても、最終的に箱シートを更新できないよね。そちらの箱サンプルシートはどうなっている？ 一応、こちらでは、ざらっと流してみて、私が予期した動きにはなっているんだけど、何か、こちらで勘違いしてるかな？
あと、コードとしては未手当のところも残っていて、それは、最後にいれこもうと考えているんだけど たとえば箱サンプルシートの合計。要件が、まだ把握しきれていないということもあるんだけど、 とりあえず、記号には、数字は含まないと考えていい？ それとも記号自体に A1 とか BB3 といったものがありうる？ 次に枝番だけど、1,2,・・・9,10,11・・・ と想定してる。 01,02,03,・・・・は想定していないけど、それでいい？
(ぶらっと)
>指摘のコードは、With c.EntireRow をうけているので、B1,J1,C1 にもどして。 了解いたしました。
今試したところ、「分類」の表示までうまくいきました。 昨日はもしかしたら「保存」→「閉じる」→「開く」がちゃんとできていなかったのかも… （やったつもりでしたが）
で、今度は枝番が表示されないのですが、ここはこちらで
UserForm4.cbx_No.List = Array("", "1", "2", "3", "4")
このようなコードを入れてもよいのでしょうか。 （枝番が出て来なくて先に進めないので）
とりあえず上記のコードを入れると「記号」が表示されました。 そこで「媒体」(cbx_Media)を選ぼうとすると 「メソッドまたはメンバーが見つかりません」のエラーが出ます。 エラーの箇所は
'cbxMedia_n の Changeイベント Sub MediaSelected(cbxMedia As MSForms.ComboBox)
です。
それで一旦VBE画面を閉じて再度ユーザーフォームを開こうとすると、次から
「実行時エラー 91
オブジェクト変数またはWithブロックが定義されていません」
のエラーが出ます。
場所は Private Sub UserForm_Initialize() の
lineClct.Add cls
です。
箱サンプルのレイアウトは、前トピの冒頭に書いたものに、A51に「データ行終了」を入れたものです。 （データ部分は空白にしています）
>とりあえず、記号には、数字は含まないと考えていい？
今のところ含まれていません。 ただ、今後も絶対に含まれないという可能性は分かりません… 新しい商品が出るたびにコードも増えるので…
枝番は 1,2... で想定しています。 現状では最大でも（それもごく稀に）3までしか出ていないとのことですが、念のために4まで用意しています。
上のエラーは私が勝手にコードを追加したからでしょうか…
(peridot)
ちょっと風邪でダウン中で、対応遅れ、申し訳なし。 まだ、寝込んでいるんだけど、とりあえず。
>で、今度は枝番が表示されないのですが、ここはこちらで
>UserForm4.cbx_No.List = Array("", "1", "2", "3", "4")
>このようなコードを入れてもよいのでしょうか。
ここには、あらかじめRowSourceでリストをしていしているのかと思っていた。 当方のテストでは、アップしたコードからは消したけど、同じようなコードを Initializeルーティンにいれて実行していた。
>そこで「媒体」(cbx_Media)を選ぼうとすると >「メソッドまたはメンバーが見つかりません」のエラーが出ます。 >エラーの箇所は
>'cbxMedia_n の Changeイベント >Sub MediaSelected(cbxMedia As MSForms.ComboBox)
これについてのコメントは後回しにする。 このようにエラーが発生すると、プロジェクト（このブックのＶＢＡコードの全体）が ｢リセット｣される。そうすると、パブリック変数、モジュールレベル変数も、すべてがリセット されるので、オブジェクト変数の中身もNothingになってしまっている。 だから、実行時エラー 9 等になる。 一度、ブックを閉じて再度読み込むか、あるいは（めんどくさいよね、それじゃ）Workbook_Openの 任意のところをクリックして、メニューの実行で実行させて。
★とにかく、分類まではでたようなのでよかった。 ところで、cbx_Media なの？？？ こちらのコードでは cbxMedia_n にしてるけど。 （lblCode_n yxyQty_n も同様） そちらのフォームでは cbx_Mediq_n ？？ もしそうなら、フォームを直すか、コードを直すか。どちらにする？
で、記号に数字があるかどうかを聞いたのは、意図としては、右側に集約するとき SK1 SK2 は SK に集約、これは明白？ もし、元の記号がSKではなく、SK1 だったり、SK2 だったり。 そうすると、SK1で集約、SK2で集約。そうする必要があるので、さぁ、どうしようかなと悩んでいて ちょっと聞いていたもの。まぁ、先のことなので、集約ルールについては、そちらでも、じっくりと 考えておいてほしい。
(ぶらっと)
枝番は Private Sub UserForm_Initialize() に上記コードを入れていました。 コンボボックスのプロパティだと、セル範囲しか指定できないんですよね？（違ってたらすみません） 特に指定するためのセルを設ける必要もないかと思って…
>ところで、cbx_Media なの？？？ こちらのコードでは cbxMedia_n にしてるけど。
すみません、書き間違えました。 cbxMedia_nです。
>SK1 SK2 は SK に集約、これは明白？
はい、そうです。 全ての記号（A列やE列の記号）は「記号+枝番」で、合計欄では「記号」のみになります。 元々、「サンプル記号」というのがあり（SK、VAといったもの）、それが何回目のデータ受信でデータを受けたかによって枝番がつきます。 2回目のデータ受信で件数が発生したものについては「記号：SK2、媒体：KK」というようにデータ受信回数の番号が記号の後に振られるので、 1回目のデータ受信にその「記号＆媒体」の組合せがなければ「SK1」が無く「SK2」だけがある、ということもあります。 そして、一日を通して同じ「記号＆媒体」の組合せのものの件数がどれだけ来たかを合計します。 この時に「SK1/KK/20件」「SK2/KK/100件」「SK3/KK/15」と有ったら合計は「SK/KK/135件」と集約されます。
記号に数字があるかどうか、で私が「今後発生するかも…」とお答えしたのは、この「記号」自体に例えば 「A1」という記号が出来て、「A11」「A12」となるかもしれない、ということでした。
なんかややこしくてすみません…
※お風邪、お大事になさってください
(peridot)
枝番コンボボックスについては、そちらの手当でOK。
cbxMedia_n については、調べてみるけど・・・・ これは、最初から、エラーなく、ここにたどり着いたときにも、ここで「メソッドまたはメンバーが見つかりません」 こうなるということ？
記号については、後回しでいいんだけど、何を言いたいかというと 今、SKは、｢今あるSK｣だと、頭にこびりついているから、なかなかぴんとこないかもしれないけど 例に挙げてくれたA1 で説明すると A11 A12 こんなものがあって、これを A1 で集約。 処理としてはこうなるんだけど、これを実現するロジックをどうしようかと考えている。（悩んでいる） もしかしたら、オリジナルの記号は｢A｣だったかもしれない。で、枝番の｢11｣｢12｣がついているのかもしれない。 さぁ、A で集約しようか、A1 で集約しようか？ どうしたらいい？ もし、記号は｢絶対に２桁｣ということならOKなんだけど？
(ぶらっと)
今、そちらで書いたと思われる、
UserForm4.cbx_No.List = Array("", "1", "2", "3", "4")
これを、こちらのコードにも書いておこうとして気がついた。
実際のユーザーフォームは、｢UserForm4｣なのかな？
こちらがアップしたコードの中では標準モジュールの BackFocusとMediaSelectedの２カ所で UserForm1 という記述をしている。これを UserForm4 に変えて欲しい。 「メソッドまたはメンバーが見つかりません」のエラーは、おそらく、これが原因。
(ぶらっと)
UserForm1をUserForm4に変えてもらえば、そちらでも動くようになると思うし そうなれば、ゴールも近いかな？
なので、上で聞いている、記号の集約ルール（コードはこちらで考えるので、文章として） を考えておいて欲しいのと、あと１点。
こちらで勝手に、媒体を選んだら、記号(枝番つき) + 媒体で箱サンプルデータの記載があれば、その数字を テキストボックスにもってくるようにしている。でも、こちらでテストしてて、この機能にあまり 意味は無いのではと思えてきた。（重複している場合は、上書きになるんだけど、それを、操作者に 書き込み前に認識してもらう方策として、こんな勝手な機能をつけた）
・もし、おもしろい機能なので残そうということなら、箱サンプル更新後、この機能で使っている元ネタテーブルも 更新しなきゃいけないので、そこを追加する。 ・もし、こんな機能、不要ということなら、この機能をばっさり、コードから削除することが必要。
いずれにしても、コードを改訂しなきゃいけないので、どちらがいいか、教えてね。
(ぶらっと)
> さぁ、A で集約しようか、A1 で集約しようか？ どうしたらいい？ > もし、記号は｢絶対に２桁｣ということならOKなんだけど？
今のところ記号は全部2ケタですが、今後絶対に3ケタ以上にならないという保証がなくて… ただ、枝番が2ケタになるのはあり得ないので、「右一文字を除外」ということでは難しいでしょうか？
UserForm1はUserForm4に変えました。
しかし今度は別のエラーが出ました。 「日付」→「分類」→「枝番」を選んでいってラベルに記号が表示されるまでは行きました。 そこで cbxMedia_1 を選んでカーソルを移動する瞬間に「プロパティの値が無効です」のエラーが延々と出ます…
上に書かれていた Enabled と Visible は両方とも False にしています。
「デバッグ」画面が出るのではなく、Microsft Forms のメッセージボックスが出ます。
上記の2点以外は初期値からいじっていないはずなんですが…
テキストボックスの上書きの件は ・もし、おもしろい機能なので残そうということなら、箱サンプル更新後、この機能で使っている元ネタテーブルも 更新しなきゃいけないので、そこを追加する。 こちらでお願いします。 追加変更もあると思うので…
(peridot)
>枝番が2ケタになるのはあり得ないので、「右一文字を除外」
了解。（以前、２桁になる可能性あるっていってた記憶があったんだけど、ないんだね？）
>テキストボックスの上書きの件は・・・・こちらでお願いします。
了解。
で、本題だよね。とにかく、こちらで、問題なく動くと言うことは、コードというより
コードの記述と実際の環境（設定）の不整合ということなので、これも調べてみるけど
コンボボックス関係で「プロパティの値が無効です」 のエラーがでるのは、MatchRequiredをTrueにして、
なおかつ、そこにない値を入力した場合が多い。
たけど、今回は Initialize ルーティンに cbx_No.List = Array("", "1", "2", "3", "4") を記述し
操作としては、そのリストから何かを選んだんだよね？
それと、｢延々と｣という表現の意味を教えてくれる？
通常は、リストにない値を入力したとき、１度でるけど、正しいものを選び直せばでなくなるけど？
(ぶらっと)
>以前、２桁になる可能性あるっていってた記憶があったんだけど、ないんだね はい。データ受信回数自体が2ケタになること自体が無いということなので、1ケタで大丈夫です。
それで、コンボボックスのエラーですが、cbx_No.List = Array("", "1", "2", "3", "4")を記述して、
その中から選びました。
そして「媒体」(cbxMedia_n)をクリックするとプルダウンに「単価マスタ」にあるリストが表示されるんですが、
それのどれを選んでも「プロパティの…」のエラーが出ます。
そして、ユーザーフォームのどこをクリックしても、「媒体」の値をクリアしても、何かの操作
（他のコントロールをクリックするとか、右上の×ボタンでユーザーフォームを閉じようとするとか）を
する度に「プロパティの…」のエラーが出続けます。
（エラーが出た後、閉じようとすればフォームを閉じることはできます）
cbxMedia_n のプロパティでMatchRequiredをFalseにするとエラーは回避できますが、これでは単価マスタに ない値でも入力できてしまうので、それは避けたいです。 （現在でも大文字小文字・全角半角を混在して入力してデータ集計の時に困ることがあるので…）
単価マスタの A B C D E F G H I J 1 単価表 2 記号 媒体名 基本単価 追加分 付帯業務 区分 基本コスト 単価 分類
A1の「単価表」の見出しがA1～C1まで結合してあるのが原因かと思って結合を解除しましたが変わりません。
>リストにない値を入力したとき、１度でるけど、正しいものを選び直せばでなくなるけど？ 正しいものが表示されていてそれを選んでいるつもりなんですが… 他にプロパティの設定が間違っているのでしょうか…
(peridot)
>cbxMedia_n のプロパティでMatchRequiredをFalseにするとエラーは回避できますが、これでは単価マスタに >ない値でも入力できてしまうので、それは避けたいです。
えっ？ここは MatchRequired = False で、そのかわりに、Style を 2 にするんじゃなかった？
なかなか、考えたもんだと、感心したんだけど？ リストに表示しているものは、空白値と単価マスタにあるもののみ。
で、入力できない仕掛けなので、リストにあるもの（あるいは選択の取り消しのための空白）しか選べないと
これは、そちらで考えた仕様だけど？
忘れているのかもしれないけど、媒体を選ぶと、同じ記号のリストボックスのリストからは、その媒体を消してしまう。
そうすると、リストにないものが選ばれている状態になる。だから MatchRequired は False 。
そちらからの要求でいれた仕様だけど忘れたのかな？
(実は、アップしたコードは、同じ記号じゃなくても選ばれた媒体コードを消てしまっているというバグを含んでいるんだけど それは最後に修正しようと思っている）
(ぶらっと)
> えっ？ここは MatchRequired = False で、そのかわりに、Style を 2 にするんじゃなかった？ > なかなか、考えたもんだと、感心したんだけど？ すみません、確かBun様と並行してお教えいただいてた時に「MatchRequired = True 、Style = 0 がいい」と言われたのでそのままにしてました！
すみませんでした…orz
> Listに無い物しか入力出来ない様にするなら、CommandButtonを押して転記する時どの道、 > ComboBox4～11の入力確認を行うでしょうから、其の時ListIndexが-1かどうか確認すればいい事と思います > 何故なら、ComboBoxのTextBox部に入力が在っても其の値がComboBoxのListに無ければListIndexは-1なのですから > 逆に空白行を入れると此れが出来なくなります > 因って、「コントロールのプロパティでStyleを「2」にして」もやめた方がいいし、 > 此れをやらなければ、空白行をListに入れる必要も無いと思います
これをずっとそのままにしてたので…
お手数をおかけしました…エラー出なくなりました。
先程ユーザーフォーム呼び出し時に
Private Sub UserForm_Initialize()
For Each myCtrl In Me.Controls
Debug.Print myCtrl.Name
If myCtrl.Name Like "lblCode_*" Then
FormLines = FormLines + 1
Set cls = New clsLine
lineClct.Add cls '←ここ
i = Split(myCtrl.Name, "_")(1)
cls.SetCombo Me.Controls("cbxMedia_" & i)
Set cls.txtQty = Me.Controls("txtQty_" & i)
Set cls = Nothing
End If
Next
上記部分で「オブジェクトまたはWithブロックが定義されていません」のエラーが出ましたが、一旦ブックを閉じて
開きなおすとエラーは出ませんでした。
それで、シートへの転記うまくいきました！
あとは書いておられるように、「作業簿_KK」のように「記号」がそれぞれ違う場合に「媒体」が消されてしまう現象は起きています。
とにかく「プロパティの～」はこちらの思い込み＆設定ミスでした 申し訳ございませんでした…
(peridot)
進捗したようでよかったね。。 で、これから、仕様の勘違い等も含めたバグつぶしが始まるわけで、それが全て完了してからと 思っていたけど、一応、以下の機能を加味したコードをアップしておく。 （コード全てではなく、改訂したプロシジャ単位でアップするので、いれかえ、ないしは追加してね）
・箱サンプルの合計欄自動生成（仕様追加） ・箱サンプル更新後の、数量データ取得（仕様追加） ・媒体を選択した際に削除するリストを、同じ記号のものに限定。（バグ対応）
(標準モジュール)
Sub Preparation() 'Workbook_Open での処理
Set dic = CreateObject("Scripting.Dictionary")
Set dicLine = CreateObject("Scripting.Dictionary")
Set dicSample = CreateObject("Scripting.Dictionary")
Set dicQty = CreateObject("Scripting.Dictionary")
Set lineClct = New Collection
Call getSample '箱サンプルからの情報の取得
Call GetPriceList '単価マスタからの情報の取得
Call GetQtyInfo '箱サンプルから数量マトリックスの取得
End Sub
Sub getSample() '箱サンプルからのデータ取り込み
Dim w As Variant
Dim f As Long
Dim e As Long
Dim s As String
Dim c As Range
Dim myCls As String
dicSample.RemoveAll
dicQty.RemoveAll
With Sheets("箱サンプル")
For Each c In .Range("A1", .Range("A" & .Rows.Count).End(xlUp))
Select Case c.Value
Case "記号"
If f <> 0 Then
e = c.Offset(-3).Row
dicSample(myCls & 0) = Array(f, e)
End If
myCls = c.Offset(-1).Value
f = c.Offset(1).Row
Case "データ行終了"
e = c.Offset(-2).Row
dicSample(myCls & 0) = Array(f, e)
Case Else
If Len(c.Value) > 0 Then
dicQty(myCls & vbTab & c.Value & vbTab & c.Offset(, 1).Value) = c.Offset(, 2).Value
End If
If Len(c.Offset(, 4).Value) > 0 Then
dicQty(myCls & vbTab & c.Offset(, 4).Value & vbTab & c.Offset(, 5).Value) = c.Offset(, 6).Value
End If
End Select
Next
End With
End Sub
'cbxMedia_n の Changeイベント
Sub MediaSelected(cbxMedia As MSForms.ComboBox)
Dim i As Long
Dim idx As Long
Dim dicA As Object
Dim dicB As Object
Dim d As Variant
Dim myCls As String
Dim myCode As String
Dim myMedia As String
Dim myNo As String
Dim dKey As String
If skipEvent Then Exit Sub
With UserForm4
skipEvent = True
Set dicA = CreateObject("Scripting.Dictionary")
Set dicB = CreateObject("Scripting.Dictionary")
myCls = .cbx_Cls.Value
myNo = .Controls("cbx_No").Value
myMedia = cbxMedia.Value
idx = Split(cbxMedia.Name, "_")(1)
myCode = .Controls("lblCode_" & idx).Caption
dKey = myCls & vbTab & myCode & myNo & vbTab & myMedia
If dicQty.exists(dKey) Then .Controls("txtQty_" & idx).Value = dicQty(dKey)
For i = 1 To FormLines
myMedia = .Controls("cbxMedia_" & i).Value
If .Controls("lblCode_" & i).Visible And .Controls("lblCode_" & i).Caption = myCode Then dicA(myMedia) = True
Next
For Each d In dic(myCls)(myCode)
If Len(d) = 0 Or Not dicA.exists(d) Then dicB(d) = True
Next
For i = 1 To FormLines
myMedia = .Controls("cbxMedia_" & i).Value
If .Controls("lblCode_" & i).Visible And .Controls("lblCode_" & i).Caption = myCode Then .Controls("cbxMedia_" & i).List = dicB.keys
Next
skipEvent = False
Set dicA = Nothing
Set dicB = Nothing
End With
End Sub
Sub GetQtyInfo() '★追加
Dim w As Variant
Dim f As Long
Dim e As Long
Dim s As String
With Sheets("箱サンプル")
For Each w In dicSample
If Right(w, 1) = "0" Then
f = dicSample(w)(0)
e = dicSample(w)(1)
s = w
Mid(s, Len(s)) = 1
dicSample(s) = .Range(.Cells(f, "A"), .Cells(e, "C")).Value
s = w
Mid(s, Len(s)) = 2
dicSample(s) = .Range(.Cells(f, "E"), .Cells(e, "G")).Value
End If
Next
End With
End Sub
Sub QtyTotal() '★追加
Dim w As Variant
Dim f As Long
Dim e As Long
Dim dicW As Object
Dim i As Long
Dim j As Long
Dim myCode As String
Dim myMedia As String
Dim myQty As Long
Dim dKey As String
Dim v As Variant
Set dicW = CreateObject("Scripting.Dictionary")
With Sheets("箱サンプル")
For Each w In dicSample
If Right(w, 1) = "0" Then
f = dicSample(w)(0)
e = dicSample(w)(1)
dicW.RemoveAll
For j = 1 To 5 Step 4
For i = f To e
myCode = .Cells(i, j).Value
If Len(myCode) > 0 Then
myCode = Left(myCode, Len(myCode) - 1)
myMedia = .Cells(i, j + 1).Value
myQty = Val(.Cells(i, j + 2).Value)
dKey = myCode & vbTab & myMedia
If Not dicW.exists(dKey) Then dicW(dKey) = Array(myCode, myMedia, 0)
v = dicW(dKey)
v(2) = v(2) + myQty
dicW(dKey) = v
End If
Next
Next
With .Range(.Cells(f, "J"), .Cells(e, "L"))
.ClearContents
.Resize(dicW.Count).Value = WorksheetFunction.Transpose( _
WorksheetFunction.Transpose(dicW.items))
End With
End If
Next
End With
Set dicW = Nothing
End Sub
(ユーザーフォームモジュール)
Private Sub UserForm_Initialize()
Dim cls As clsLine
Dim e As MSForms.Control
Dim myCtrl As Object
Dim i As Long
FormLines = 0
For Each myCtrl In Me.Controls
Debug.Print myCtrl.Name
If myCtrl.Name Like "lblCode_*" Then
FormLines = FormLines + 1
Set cls = New clsLine
lineClct.Add cls
i = Split(myCtrl.Name, "_")(1)
cls.SetCombo Me.Controls("cbxMedia_" & i)
Set cls.txtQty = Me.Controls("txtQty_" & i)
Set cls = Nothing
End If
Next
cbx_No.List = Array("", "1", "2", "3", "4")
skipEvent = True
cbx_Cls.Clear
cbx_Cls.List = dic.keys
skipEvent = False
End Sub
Private Sub CommandButton1_Click() '転記
Dim f As Long
Dim x As Long, y As Long
Dim myCls As String, myCode As String, myMedia As String, myQty As String
Dim myNo As String
Dim i As Long
Dim ctrl As Object
Dim w As String
Dim myDate As String
Dim v As Variant
Dim okFlag As Boolean
Dim strCol As String
myCls = cbx_Cls.Value
myNo = cbx_No.Value
myDate = txt_Date.Value
If Not IsDate(myDate) Then
MsgBox "日付を正しく入れてください"
Exit Sub
End If
If Len(myCls) = 0 Or Len(myNo) = 0 Then
MsgBox "分類、枝番 のいずれかが選択されていません"
Exit Sub
End If
If myNo Mod 2 = 0 Then
i = 2
strCol = "E"
Else
i = 1
strCol = "A"
End If
v = dicSample(myCls & i)
For i = 1 To FormLines
If Me.Controls("lblCode_" & i).Visible Then
myMedia = Me.Controls("cbxMedia_" & i).Value
myCode = Me.Controls("lblCode_" & i).Caption
myQty = Me.Controls("txtQty_" & i).Value
If Len(myMedia) > 0 And Len(myQty) > 0 Then
okFlag = False
For x = LBound(v, 1) To UBound(v, 1)
If v(x, 1) = myCode & myNo And v(x, 2) = myMedia Or Len(v(x, 1)) = 0 Then
v(x, 1) = myCode & myNo
v(x, 2) = myMedia
v(x, 3) = myQty
okFlag = True
Exit For
End If
Next
If Not okFlag Then
MsgBox "シートに以下のデータを書き込む余裕がありません" & vbLf & _
myCode & myNo & "/" & myMedia & "/" & myQty
End If
End If
End If
Next
w = myCls & 0
f = dicSample(w)(0)
Application.ScreenUpdating = False
With Sheets("箱サンプル")
.Range("F1").Value = txt_Date.Value
.Cells(f, strCol).Resize(UBound(v, 1), UBound(v, 2)).Value = v
End With
Call QtyTotal
Application.ScreenUpdating = True
Call LineClear
Call GetQtyInfo
MsgBox "箱サンプルへの書き込みが完了しました"
End Sub
(ぶらっと)
ぶらっと様
ありがとうございます。
コードを追加・変更いたしました。 すると、ユーザーフォームにデータを入力してコマンドボタン1を押すと
Sub QtyTotal() の
.Resize(dicW.Count).Value = WorksheetFunction.Transpose( _
WorksheetFunction.Transpose(dicW.items))
ここの部分で「型が一致しません」のエラーになります。（シートへの転記自体はできてます）
その後、再度ユーザーフォームを開こうとすると前に書きました
Private Sub UserForm_Initialize()
For Each myCtrl In Me.Controls
Debug.Print myCtrl.Name
If myCtrl.Name Like "lblCode_*" Then
FormLines = FormLines + 1
Set cls = New clsLine
lineClct.Add cls '←ここ
i = Split(myCtrl.Name, "_")(1)
cls.SetCombo Me.Controls("cbxMedia_" & i)
Set cls.txtQty = Me.Controls("txtQty_" & i)
Set cls = Nothing
End If
Next
上記部分で「オブジェクトまたはWithブロックが定義されていません」のエラーが頻発します。
(ブックを保存して開きなおすと最初は出ませんが、ユーザーフォームでエラーになった後だと出続けます）
合計欄はちゃんと合計されてます。
「型が一致しません」は何の型が違うのでしょうか
(peridot)
「型が一致しません」については、今から調べてみるね。
で、いったんエラーになった後のことだけで、上のほうでも述べたように、エラーになって、 もういいやということで「終了」をクリックすると、「ＶＢＡコード一式」が「リセット」される。 ということは、各種変数が初期値に戻るということで、ブック読み込み時に自動的にセットしていた 諸々の変数がNothingになってしまうので、これを復旧しなきゃいけない。 方法は、ブックを閉じて、開きなおすか、あるいは、ブックが開かれた時、Workbook_Openでやっていることは 標準モジュールの「Preparation」を実行しているだけなので、閉じて開きなおさなくても ツール->マクロ->マクロ で 「Preparation」を実行させても、復旧するよ。
(ぶらっと)
型が一致しません の件、原因は、合計すべきものが何も無い空っぽの場合のバグ。 （転記された分類の合計のみを変更すればよかったんだけど、面倒なので、全ての合計を作り直していて 他の分類で、データが無い場合にエラーというおそまつ！！）
ついでに転記された分類のみの合計作成に変えた。以下の２つのプロシジャいれかえお願い。
Private Sub CommandButton1_Click() '転記
Dim f As Long
Dim x As Long, y As Long
Dim myCls As String, myCode As String, myMedia As String, myQty As String
Dim myNo As String
Dim i As Long
Dim ctrl As Object
Dim w As String
Dim myDate As String
Dim v As Variant
Dim okFlag As Boolean
Dim strCol As String
myCls = cbx_Cls.Value
myNo = cbx_No.Value
myDate = txt_Date.Value
If Not IsDate(myDate) Then
MsgBox "日付を正しく入れてください"
Exit Sub
End If
If Len(myCls) = 0 Or Len(myNo) = 0 Then
MsgBox "分類、枝番 のいずれかが選択されていません"
Exit Sub
End If
If myNo Mod 2 = 0 Then
i = 2
strCol = "E"
Else
i = 1
strCol = "A"
End If
v = dicSample(myCls & i)
For i = 1 To FormLines
If Me.Controls("lblCode_" & i).Visible Then
myMedia = Me.Controls("cbxMedia_" & i).Value
myCode = Me.Controls("lblCode_" & i).Caption
myQty = Me.Controls("txtQty_" & i).Value
If Len(myMedia) > 0 And Len(myQty) > 0 Then
okFlag = False
For x = LBound(v, 1) To UBound(v, 1)
If v(x, 1) = myCode & myNo And v(x, 2) = myMedia Or Len(v(x, 1)) = 0 Then
v(x, 1) = myCode & myNo
v(x, 2) = myMedia
v(x, 3) = myQty
okFlag = True
Exit For
End If
Next
If Not okFlag Then
MsgBox "シートに以下のデータを書き込む余裕がありません" & vbLf & _
myCode & myNo & "/" & myMedia & "/" & myQty
End If
End If
End If
Next
w = myCls & 0
f = dicSample(w)(0)
Application.ScreenUpdating = False
With Sheets("箱サンプル")
.Range("F1").Value = txt_Date.Value
.Cells(f, strCol).Resize(UBound(v, 1), UBound(v, 2)).Value = v
End With
Call QtyTotal(myCls)
Application.ScreenUpdating = True
Call LineClear
Call GetQtyInfo
MsgBox "箱サンプルへの書き込みが完了しました"
End Sub
Sub QtyTotal(myCls As String)
Dim w As Variant
Dim f As Long
Dim e As Long
Dim dicW As Object
Dim i As Long
Dim j As Long
Dim myCode As String
Dim myMedia As String
Dim myQty As Long
Dim dKey As String
Dim v As Variant
Set dicW = CreateObject("Scripting.Dictionary")
With Sheets("箱サンプル")
w = myCls & 0
f = dicSample(w)(0)
e = dicSample(w)(1)
dicW.RemoveAll
For j = 1 To 5 Step 4
For i = f To e
myCode = .Cells(i, j).Value
If Len(myCode) > 0 Then
myCode = Left(myCode, Len(myCode) - 1)
myMedia = .Cells(i, j + 1).Value
myQty = Val(.Cells(i, j + 2).Value)
dKey = myCode & vbTab & myMedia
If Not dicW.exists(dKey) Then dicW(dKey) = Array(myCode, myMedia, 0)
v = dicW(dKey)
v(2) = v(2) + myQty
dicW(dKey) = v
End If
Next
Next
With .Range(.Cells(f, "J"), .Cells(e, "L"))
.ClearContents
If dicW.Count > 0 Then .Resize(dicW.Count).Value = _
WorksheetFunction.Transpose(WorksheetFunction.Transpose(dicW.items))
End With
End With
Set dicW = Nothing
End Sub
(ぶらっと)
ありがとうございます！
何回かテストしましたが今のところうまく動いています。
もしエラーが出てどうしても対処法が分からない時はまたお世話になるかもしれませんが（できるだけ自力で解決する努力はします） 本当にありがとうございました
(peridot)
ぶらっと様
すみません、もう一つお伺いしたいのですが…
ユーザーが「箱サンプル」シートにユーザーフォームからではなく直接手打ちで入力してしまった場合に「合計」が 計算されないので、一旦Deleteキーでクリアしてユーザーフォームから入力しようとしました、 すると、ユーザーフォームで「分類」→「枝番」→「記号」→「媒体名」を選択した段階で、クリアしたはずの 数値がユーザーフォームに出てしまいます。 そして以下の現象が起きます。
（1） 「箱サンプル」シートに以下のように手打ち
E F G 1 2 記号 媒体名 件数 3 SK2 KZ 10 4 SK2 MZ 15
（2）DeleteキーでE3～G4をクリア （3）ユーザーフォームを表示、「分類：作業簿_SK」→「枝番：2」→「記号：SK」→「媒体名：KZ」を選択 （4）件数に「10」が表示される（「MZ」には「15」が表示される） （5）「KZ」を「21」に更新して（「MZ」は選択しないで）入力ぼコマンドボタンを押す （6）「箱サンプル」シートに下記のように転記される
E F G 1 2 記号 媒体名 件数 3 SK2 KZ 21 4 SK2 MZ 15 ←ユーザーフォームで選択していないのに入力される
（7）次にユーザーフォームを開くと「KZ」の数値は「10」（手打ちした時の数値）で表示されます。
データ消去をマクロの.ClearContentsで行っても同じです。 手打ちしてしまった時の値をずっと保持し続けてしまう現象はどうすれば解消されますでしょうか。
★追加です・その１ 上記とは別だと思いますが、枝番が「3」以降の場合、既に入力済みのデータを選択した時 （例えば「SK3/KZ/50」が入力されていたとしてユーザーフォームで「SK3/KZ」を選択した場合） 枝番1や2では入力済みの「件数」がユーザーフォームに表示されますが、3以降では件数に何も表示されません
★追加です・その２ 今回のようにユーザーが手動でベタ打ちしてしまった場合、その時点で「合計」はされません。 その後ユーザーフォームから何かしら入力の操作を行うとベタ打ちした分も合計されますが、 もしベタ打ちしてしまった場合に備えて、「合計」のコードだけを別に独立させることはできますでしょうか。 シートの上にコマンドボタンを置いて「手動合計」のようなコードで合計させようかと思いましたが、 A列側のデータとE列側のデータの比較、既に合計されていつデータとの集約などをどうすればよいか ずっと考えていたのですが思いつかなくて… Sub QtyTotal(myCls As String) これを応用できないかと色々試しましたがどうしてもうまくいきません…
(peridot)
まず、簡単なところから。 SK3 があるのにコピーされない件、箱サンプルシートからの情報取り込みが、初期段階のみで行っていたので これを、箱サンプルシートの更新の都度、再度取り込むことで、ここはＯＫになる。 で、強制的に合計処理を行う件については、そちらで着目している Sub QtyTotal(myCls As String) これを活用することができる。 ただ、その前に、箱サンプルシートのデータ取り込みも行う必要があるけど。
で、やっかいなのが、手作業でＡ～Ｃ，Ｅ～Ｇを変更。ありうるよね。実務としては。 (本当は禁止したいけど） この時、クリア前のデータを、保持していて、そこにユーザーフォームから追加という構造なので、シート上は 値が無いのに、クリア前に存在していたものも、更新に、そのまま使われてしまう。 シートイベントで、ここが変更されたら自動更新ということもできないことはないけど、ロジックが きわめて入り組んでしまうので、悩むところ。
いずれにしても、ちょっと時間ください。
(ぶらっと)
なるほど、情報取り込みをブックを開くタイミングで行っているので一度開いたデータを変更して そのまま読み込んだりできないことがあるんですね。 入力した人から「数字が出るのと出ないのとある」と言われてテストしていたので、テストで追加したデータのみを見ていました。
手作業の変更は、一度ユーザーフォームで入力したものを「１個だけ訂正・追加」という時によく起きます。 入力者としては「１個だけだから」というつもりでやってしまうようです。 この辺の徹底も頭を痛めるところです…
(peridot)
結局、箱サンプルシートを手作業で変更した際にも自動的に合計処理を行うよう改訂。 なお、今後、単独で、合計処理を行うような部分を追加する場合は、以下で記述する シートモジュールのコードを参考にしてがんばってほしい。
(標準モジュールのパブリック変数 追加）
Public skipChange As Boolean '★追加 2012/4/24
(ユーザーフォームモジュール)
CommandButton1_Click の Application.ScreenUpdating = False から MsgBox "箱サンプルへの書き込みが完了しました" までを
Application.ScreenUpdating = False
skipChange = True '★追加 2012/4/24
With Sheets("箱サンプル")
.Range("F1").Value = txt_Date.Value
.Cells(f, strCol).Resize(UBound(v, 1), UBound(v, 2)).Value = v
End With
Call QtyTotal(myCls)
skipChange = False '★追加 2012/4/24
Application.ScreenUpdating = True
Call LineClear
Call getSample '★追加 2012/4/24
Call GetQtyInfo
MsgBox "箱サンプルへの書き込みが完了しました"
(で、箱サンプル シートのシートモジュールに） 15:37 一部変更
Private Sub Worksheet_Change(ByVal Target As Range)
Dim w As Variant
Dim f As Long
Dim e As Long
Dim myCls As String
If skipChange Then Exit Sub
skipChange = True
For Each w In dicSample
If Right(w, 1) = "0" Then
myCls = Left(w, Len(w) - 1)
f = dicSample(w)(0)
e = dicSample(w)(1)
If Not Intersect(Target, Range("A" & f & ":G" & e)) Is Nothing Then
Call getSample
Call GetQtyInfo
Call QtyTotal(myCls)
Call getSample
Call GetQtyInfo
MsgBox myCls & " についての箱サンプルの合計処理を自動実行しました"
End If
End If
Next
skipChange = False
End Sub
(ぶらっと)
ぶらっと様
ありがとうございます。
最初に改訂コードを貼りつけて、「箱サンプル」シートに手打ち入力しようとすると、箱サンプルのシートモジュール
For Each w In dicSample
で「オブジェクトが必要です」のエラーが出たのですが、一旦保存してから再度試すと出なくなりました。 前のコードの名残でしょうか。
また、箱サンプルシートの一つのセルをクリックする・あるいは値を入力すると一つのセルごとに 「作業簿_SKについての箱サンプルの合計処理を自動実行しました」 のメッセージが出る（クリックしただけで、値を入力しなくても出る）のは仕様ということでよろしいでしょうか（一応、入力者に説明しようと思いますので…）
> なお、今後、単独で、合計処理を行うような部分を追加する場合は、以下で記述する > シートモジュールのコードを参考にしてがんばってほしい。
了解いたしました。ありがとうございます。 その点で後学のためにお教えいただきたいのですが、
f = dicSample(w)(0)
e = dicSample(w)(1)
これらは何を指しているのでしょうか？
(peridot)
>「オブジェクトが必要です」のエラーが出たのですが、一旦保存してから再度試すと出なくなりました。
何度かいっているように、プロジェクトがリセットされると、モジュールレベルの変数も初期化される。 エラーでとまった場合もそうだけど、モジュールコードを打ち直すと、これは、そのものズバリ、リセットされる。 なので、閉じて開くか、前にも言ったように、Preparationを実行するか、いずれかで。
>（クリックしただけで、値を入力しなくても出る）
シート上で値を変更すると、その都度、合計処理を行いメッセージをだしているけど、クリックだけで？ Worksheet_Change なので、それは考えにくいんだけど？Worksheet_SelectionChange なら、ありうるけど？ 一応、こちらでもチェックしてみるね。
↑ やっぱり、クリックだけでは、処理は行われないし、当然メッセージもでないよ？？
>f = dicSample(w)(0)
これに限らず、コードで使っているDictionaryの概説のようなメモを、あとでアップするけど、とりあえず dicSample内で、キーが、分類0 になっているもののデータはLBoundが0の一次元配列で その分類に関する 箱サンプル上のデータ開始行とデータ終了行が格納されている。なので、その配列(0) なので 開始行。
(ぶらっと)
すみません、説明が足りなかったです… 「クリックだけで」というか、ダブルクリックでセルを編集可能な状態にして、値を入力しないで…ということです。 一度セルを編集可能にしているのでChangeイベントが発生するのは当たり前…なんですよね？
(peridot)
>ダブルクリックでセルを編集可能な状態にして、値を入力しないで
うん。この状態は、空白値が入力されたという状況なのでね。
以下、コードで使っているDictionary メモ
dic 単価マスタに存在する分類、記号、媒体の組合せのリスト。最初に１回、GetPriceListで生成。
内部的には 親dic（キーは分類） 子dic(キーは記号) 孫dic(キーは媒体）の三層構造
dicLine 単価マスタの分類ごとの記号・媒体の組合せの行数
キー 分類0 データが行数
キー 分類n (n は 1～）データが記号 フォーム上でラベルのキャプションセットに使用
dicSample 箱サンプルシート情報
キー 分類0 データは 当該分類に関する箱サンプルシート上のデータ開始行と終了行を格納した一次元配列
キー 分類1 データは 当該分類に関するA～C列のセルの値（二次元配列）
分類2 データは 当該分類に関するE～G列のセルの値（二次元配列）
dicQty 箱サンプルシートにセットされている数量情報。ユーザーフォームでマッチすればテキストボックスに抽出。 キー 分類 tab 記号枝番 tab 媒体 データが シート上の数量
(ぶらっと)
ぶらっと様
詳しいご説明をありがとうございます。 dictionaryオブジェクトはよく使われるのにあまり理解できていなかったので、解説をいただいて助かりました。 今後の応用のために勉強します。
ありがとうございました
(peridot)
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.