ＶＢＡで表作成中解らないことだらけ・・・ひとつずつ教えてください。

質問

ブックの種類
入力フォーム→日付を設定するフォーム画面です。
book→予め出来ている表（Ｂ５・Ｂ７・Ｂ９・Ｂ１０・Ｉ５はタイトル？になります）
　　　Ｂ　　Ｉ　　　Ｌ　・・・
４　　　　　　　　　日付・・・
５　商品名　コード　曜日・・・
６　商品名　コード　数値・・・
７　　　小計　　　　数値・・・
８　商品名　コード　数値・・・
９　　　小計　　　　数値・・・
１０　　合計　　　　数値・・・
入力データ→日付（曜日）、区分、商品名、商品数、コードが表になっています。

まず入力フォームで日付をセットします。
次にbookに入力フォームで入力した日付から１ヶ月間を表示させます。
(1) 日付設定表に設定日付をキーにして入力データブックより検索
(2) 検索日付が一致すれば、該当商品名、コード、区分、商品数等を取得
(3) 区分:1の場合は、該当日付の下の６行に、区分:2の場合は、８行に設定(同一商品の場合は加算)
但し、新しい商品の場合は行を追加→ 区分:1の場合は6行以降に、区分:2)の場合は8行以降に追加する
(4)区分ごとの小計を表示
(5)合計を表示
(6)bookのみ処理した日付と時間で保存
(7)入力データのブックを閉じる。

出来ているところは日付を貼り付けるまでは教えてもらいながらですができています。

明日中とのことなのでよろしくお願いします。

回答No.1

pkh4989 · ベストアンサー

引き続き
不具合等はあるかも知れませんが、
以下のマクロを追加して、試してみてください。

Private Sub CommandButton1_Click()

　 '一番最後に追加してください
　　'商品情報の編集
　　Call Edit_Shouhin(wSh2) '←追加
End Sub

'商品情報の編集
Sub Edit_Shouhin(wSh2 As Worksheet)
　　Dim wC　　　　　As Integer
　　Dim mC　　　　　As Integer
　　Dim wDate　　　 As String
　　Dim hNm　　　　 As String
　　Dim hCd　　　　 As String
　　Dim hKbn　　　　As String
　　Dim hSu　　　　 As Integer
　　Dim sTot1　　　 As Integer
　　Dim sTot2　　　 As Integer
　　Dim aSum　　　　As Integer
　　Dim Kbn1　　　　As Integer
　　Dim Kbn2　　　　As Integer
　　Dim wI　　　　　As Integer
　　Dim fflg　　　　As Boolean
　　Dim wSu　　　　 As Integer
　　'
　　sTot1 = 7: sTot2 = 9: aSum = 10
　　Kbn1 = 6: Kbn2 = 8
　　With wSh2
　　　　mC = .Cells(5, 12).End(xlToRight).Column
　　　　For wC = 12 To mC
　　　　　　wDate = wSh2.Cells(4, wC)
　　　　　　'商品情報取得
　　　　　　Call Get_HinData(wDate, hNm, hCd, hKbn, hSu)
　　　　　　Select Case hKbn
　　　　　　　　Case "1"　　'区分1
　　　　　　　　　　If .Cells(6, "B") = "" Then
　　　　　　　　　　　　.Cells(6, "B") = hNm　　　　　　'商品名
　　　　　　　　　　　　.Cells(6, "I") = hCd　　　　　　'商品コード
　　　　　　　　　　　　.Cells(6, wC) = hSu　　　　　　 '数量
　　　　　　　　　　Else
　　　　　　　　　　　　fflg = False
　　　　　　　　　　　　For wI = 6 To Kbn1
　　　　　　　　　　　　　　If .Cells(wI, "B") = hNm Then
　　　　　　　　　　　　　　　　.Cells(wI, wC) = hSu　　'数量
　　　　　　　　　　　　　　　　fflg = True
　　　　　　　　　　　　　　　　Exit For
　　　　　　　　　　　　　　End If
　　　　　　　　　　　　Next
　　　　　　　　　　　　If fflg = False Then
　　　　　　　　　　　　　　.Rows(sTot1).Insert Shift:=xlDown
　　　　　　　　　　　　　　.Cells(sTot1, "B") = hNm　　'商品名
　　　　　　　　　　　　　　.Cells(sTot1, "I") = hCd　　'商品コード
　　　　　　　　　　　　　　.Cells(sTot1, wC) = hSu　　 '数量
　　　　　　　　　　　　　　Kbn1 = Kbn1 + 1
　　　　　　　　　　　　　　Kbn2 = Kbn2 + 1
　　　　　　　　　　　　　　sTot1 = sTot1 + 1
　　　　　　　　　　　　　　sTot2 = sTot2 + 1
　　　　　　　　　　　　　　aSum = aSum + 1
　　　　　　　　　　　　End If
　　　　　　　　　　End If
　　　　　　　　Case "2"　　'区分2
　　　　　　　　　　If .Cells(Kbn1 + 2, "B") = "" Then
　　　　　　　　　　　　.Cells(Kbn1 + 2, "B") = hNm　　 '商品名
　　　　　　　　　　　　.Cells(Kbn1 + 2, "I") = hCd　　 '商品コード
　　　　　　　　　　　　.Cells(Kbn1 + 2, wC) = hSu　　　'数量
　　　　　　　　　　Else
　　　　　　　　　　　　For wI = Kbn1 + 2 To Kbn2
　　　　　　　　　　　　　　If .Cells(wI, "B") = hNm Then
　　　　　　　　　　　　　　　　.Cells(wI, wC) = hSu　　'数量
　　　　　　　　　　　　　　　　fflg = True
　　　　　　　　　　　　　　　　Exit For
　　　　　　　　　　　　　　End If
　　　　　　　　　　　　Next
　　　　　　　　　　　　If fflg = False Then
　　　　　　　　　　　　　　.Rows(sTot2).Insert Shift:=xlDown
　　　　　　　　　　　　　　.Cells(sTot2, "B") = hNm　　'商品名
　　　　　　　　　　　　　　.Cells(sTot2, "I") = hCd　　'商品コード
　　　　　　　　　　　　　　.Cells(sTot2, wC) = hSu　　 '数量
　　　　　　　　　　　　　　Kbn2 = Kbn2 + 1
　　　　　　　　　　　　　　sTot2 = sTot2 + 1
　　　　　　　　　　　　　　aSum = aSum + 1
　　　　　　　　　　　　End If
　　　　　　　　　　End If
　　　　　　End Select
　　　　Next
　　　　'
　　　　'小計設定(区分1)
　　　　For wC = 12 To mC
　　　　　　wSu = 0
　　　　　　For wI = 6 To Kbn1
　　　　　　　　wSu = wSu + .Cells(wI, wC)
　　　　　　Next
　　　　　　.Cells(sTot1, wC) = wSu
　　　　Next
　　　　'小計設定(区分2)
　　　　For wC = 12 To mC
　　　　　　wSu = 0
　　　　　　For wI = Kbn1 + 2 To Kbn2
　　　　　　　　wSu = wSu + .Cells(wI, wC)
　　　　　　Next
　　　　　　.Cells(sTot2, wC) = wSu
　　　　Next
　　　　'合計設定
　　　　For wC = 12 To mC
　　　　　　wSu = .Cells(sTot1, wC) + .Cells(sTot2, wC)
　　　　　　.Cells(aSum, wC) = wSu
　　　　Next
　　End With
End Sub
'商品情報取得
Sub Get_HinData(wDate As String, hNm As String, hCd As String, hKbn As String, hSu As Integer)
　　Dim wData　　　 As Worksheet
　　Dim wI　　　　　As Integer
　　'
　　Set wData = Workbooks("入力データ.xls").Worksheets("Sheet2")　'←実際のブック名とシート名に変更
　　With wData
　　　　mR = .Cells(Rows.Count, "B").End(xlUp).Row
　　　　For wI = 3 To mR
　　　　　　If .Cells(wI, "B") = wDate Then　　　　 '←ここで両方の日付を確認してください
　　　　　　　　hNm = .Cells(wI, "T")
　　　　　　　　hCd = .Cells(wI, "BA")
　　　　　　　　hKbn = .Cells(wI, "M")
　　　　　　　　hSu = .Cells(wI, "AQ")
　　　　　　　　Exit For
　　　　　　End If
　　　　Next
　　End With
End Sub

補足

すみません・・・
ありがとうございます。
初心者っていうのもありよくわからないんですが・・・

ひとつずつ説明していただいてもいいですか？

ほんとすみません・・・

品名、コード、数値、貼り付けされませんでした・・・。

説明不足だった場合すみません・・・。

入力データからの貼り付けってどこでされているのでしょうか・・・？

品名とコードを入れる際にセルが結合してあるんですが表示されないのと何か関係あるのでしょうか？

お手数ですがひとつずつよろしくお願いします

回答No.3

pkh4989

ここでは、正しく商品情報が区分通りで追加設定及び小計、合計まで計算されます。
なので、何処かの仕様が合わないかも知れませんので、デバッグで一つ一つ確認してみてください。

Private Sub CommandButton1_Click()
　　'商品情報の編集
　　Call Edit_Shouhin(wSh2)　'←ここでデバッグしてください。(PF9を押す)
End Sub

上記の　Call Edit_Shouhin(wSh2) で止まりますので、「PF8→1行づづ実行」を押しながら
データの設定などを確認してくださいね。
Sub Edit_Shouhin(wSh2 As Worksheet)
このモジュールの頭から正しく全てが通るかを確認、wDate 変数に正しく日付が設定されるかなど・・・

お礼

ありがとうございます！！
VBA 表作成　続続

というタイトルで再び立ち上げました。

よろしくお願いします

補足

ありがとうございます。

今パソコンと実際に使っているパソコンが違うためできませんが、明日、やってみて再度わからないところがあれば質問させていただきます。

いったん締めさせていただきますね♪

また同じタイトルで出すのでその時はよろしくお願いします。

私自身ネットで調べたところFindを使うと思っていたので・・・（苦笑）

予想が外れました；；

これを簡単に示すことはできないんですよね？

わかりやすく簡潔？に…みたいな

回答No.2

pkh4989

商品情報が表示されないのは、多分検索処理だと思います。
以下のモジュールの中で

'商品情報の編集
Sub Edit_Shouhin(wSh2 As Worksheet)

　If .Cells(wI, "B") = wDate Then　　 '←ここで両方の日付を確認してください

コメントしたように、デバッグしてみてください。
この行で「F9」を押すと色反転されます。実行するとここで止まりますので、
マウスで、両方の日付形を確認してみてください。
例えば、.Cells(wI, "B") → "mm/dd" の形式
　　　　wDate → "yyyy/mm/dd"　　だと駄目ですので、両方のTypeを合わせる必要があります

.Cells(wI, "B") → "mm/dd"　/　wDate → "yyyy/mm/dd"
の場合は、
　If .Cells(wI, "B") = Format(wDate,"mm/dd") Then　に修正してください。

補足

できたんですが、デバック表示にはならなっかたんですが・・・
日付を１ヶ月貼り付けたブックで
６行目
Ｂ列と数値は入っているもののコードが入っていません。
挿入された部分が６行目とは違い結合されていなく、コードの場所もなくなってしまいました。数値も挿入された部分は全て同じ数値になってしまいます。

区分２も貼り付けがされていませんでした。

出来たのは日付が一致しないときのみの表作成はできました。

しかし一致する際の表ができていません・・・。

この表示で解りますでしょうか？

自分でも何言ってるかわからないんですが；；

ひとつずつでもいいですか？

１つ目
区分２の品名とコードが表示されません。
コードが表示されません。

２つ目
挿入された際の貼り付けが表示されません。

３つ目
数値が指定された一致したところだけの貼り付けが全てに貼り付けられています。

今わかるのはこの３つです。

忙しいと思いますがよろしくお願いします。