エクセル表から項目と交点データを抽出する追加質問

質問

tom04さんから教えていただいた方法でSheet1のデータをダブルクリックしてSheet2へのデータ抽出はできたのですが入力漏れの無いように入力済みのセルを毎回黄色に色付けしています。ダブルクリックして入力したセルが自動的に黄色に色付けされるまたは、入力済みが確認できるようなことができるようにできるとありがたいのですがよろしくお願いします。

回答No.2

tom04 · ベストアンサー

続けてお邪魔します。

ご要望の
※F列から日付&出荷台数が表記されています。
収容数が30個の製品に対して100の注文がある場合、出荷台数30の発注書3枚と10の発注書1枚を発行する必要があります。セルをダブルクリックし、注文数が収容数以上の場合この様なデータ（30の発注書データ3つと10の発注書データ1つ）がSHEET2に・・・※

の件についてですが、
↓の画像のような感じでよいのでしょうか？
今回はF列以降に日付・数値データがあるものとしています。

上側がSheet1でコードを載せるSheet・下側がSheet2としています。
画像ではSheet1のH3セルをダブルクリックした後の状態になります。
すなわちSheet1のダブルクリックしたセルH3セルに100という数値が入っていて、「入数？」が「30」
というコトにしていますので、「30」の発注書？が3つの項目に・残りの「10」の発注書が1つの項目に
振り分けるようにしてみました。
尚、色を付ける条件は前回と一緒にしています。
このような状態でよいのであれば、
今までのコードはすべて削除し↓のコードのしてみてください。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim i As Long, j As Long, k As Long, cnt As Long, endRow As Long, wS2 As Worksheet
Dim Hako As Long, Hasuu As Long
Set wS2 = Worksheets("Sheet2")
If Target.Row > 1 And Target.Column > 5 And Target > 0 Then
Cancel = True
If Target.Interior.ColorIndex = 6 Then
MsgBox "入力済みです"
Exit Sub
Else
Hako = Cells(Target.Row, "B")
Hasuu = Target Mod Hako
If Hasuu = 0 Then
cnt = Int(Target / Hako)
Else
cnt = Int(Target / Hako) + 1
End If

For k = 1 To cnt
endRow = wS2.Cells(Rows.Count, "A").End(xlUp).Row
If WorksheetFunction.CountA(wS2.Rows(endRow)) = 0 Or _
WorksheetFunction.CountA(wS2.Rows(endRow)) = 9 Then
i = endRow + 1
j = 1
Else
i = endRow
j = wS2.Cells(endRow, Columns.Count).End(xlToLeft).Column + 1
End If
With wS2.Cells(i, j)
.Value = Cells(Target.Row, "A")
.Offset(, 1) = Cells(1, Target.Column)
If Hasuu > 0 Then
If k < cnt Then
.Offset(, 2) = Hako
Else
.Offset(, 2) = Hasuu
End If
Else
.Offset(, 2) = Hako
End If
End With
Next k
Target.Interior.ColorIndex = 6
End If
End If
End Sub

※　何度も言いますが、Sheet2の配置が1列・1行でもずれると全く意図しない動きになりますので、
表の配置は正確に伝わらないと無意味なコードになってしまいます。m(_ _)m

お礼

ありがとうございます。マクロの内容はさっぱり分りませんが前回までの条件を引きついたままで振り分けができることは確認しました。今回の件でマクロを作るまではできないまでも、内容がわかるくらいまでに勉強してみようかという意欲ができました。本当にいい経験になりました。重ねてありがとうございました。

回答No.1

tom04

こんばんは！

http://okwave.jp/qa/q8303925.html
↑
のNo.2の方法でよかったのですね？

前回の画像通りの配置として・・・
余計なお世話かもしれませんが、黄色のセルをダブルクリックすると
マクロが実行されないようにしてみました。
「塗りつぶしなしのセルをダブルクリックすると前回の操作+そのセルを黄色に塗りつぶすようにしています。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 'この行から
Dim i As Long, j As Long, endRow As Long, wS2 As Worksheet
Set wS2 = Worksheets("Sheet2")
If Target.Row > 1 And Target.Column > 1 Then
Cancel = True
If Target.Interior.ColorIndex = 6 Then
MsgBox "入力済みです"
Exit Sub
Else
endRow = wS2.Cells(Rows.Count, "A").End(xlUp).Row
If WorksheetFunction.CountA(wS2.Rows(endRow)) = 0 Or _
WorksheetFunction.CountA(wS2.Rows(endRow)) = 9 Then
i = endRow + 1
j = 1
Else
i = endRow
j = wS2.Cells(endRow, Columns.Count).End(xlToLeft).Column + 1
End If
With wS2.Cells(i, j)
.Value = Cells(Target.Row, "A")
.Offset(, 1) = Cells(1, Target.Column)
.Offset(, 2) = Target
End With
Target.Interior.ColorIndex = 6
End If
End If
End Sub 'この行まで

※　データが新しくなった場合（おそらく月が変わった場合？）はセルの対象セルの色は
手動で「塗りつぶしなし」にしてください。

こんな感じではどうでしょうか？m(_ _)m

お礼

ありがとうございます。入力確認だけでなく2重入力防止機能＋メッセージまで付けて頂いて申し訳ありませんでした。
今回のマクロを使用してもう一つ”できたらいいな”がありました。
今回の発注書は実は納品書みたいな物を兼ねています。納入する箱毎に収容数単位で発行する必要があります。今回のマクロをいれるsheet1は、A列は品番、B列から日付&出荷台数が表記されている表に対して作成して頂きましたが、実はA列は品番、B列は収容数（製品品番により1箱に入る数が異なります）、C～E列は発注書と関係ないデータ、F列から日付&出荷台数が表記されています。
収容数が30個の製品に対して100の注文がある場合、出荷台数30の発注書3枚と10の発注書1枚を発行する必要があります。セルをダブルクリックし、注文数が収容数以上の場合この様なデータ（30の発注書データ3つと10の発注書データ1つ）がSHEET2に表記されるようにできませんか？よろしくお願いします。