[[20180527115856]]　『入力した日付をと一致する交点に入力するマクロ』（ten）　ページの最後に飛ぶ

『入力した日付をと一致する交点に入力するマクロ』（ten）

製品ごとの出荷日を入力する列（B2以降）があり、C1からカレンダーのように日付が入力してあります。
出荷日を入力するとその日付と等しい交点に5/2出荷のように入力されるようなマクロを考えているのですがどのようにしたらいいでしょうか？

品名　出荷日　5/1　　5/2　　　5/3 　　　5/4・・・
AAA 　5/2 　　　　 5/2出荷
・
・
・

このような感じで、関数で各セルに　=IF(TEXT($B2,"m/d")=TEXT(D$2,"m/d"),TEXT($B2,"m/d")&"出荷","")と入力して同じようなことは出来ているのですが、非常にデータ量が多く、よくExcelが15分以上止まってしまうことがあることからマクロで出来ないかと思った次第です。

解決策、アドバイス等ありましたらお願いします。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

使い方は、Worksheet_Changeで検索してください

 Option Explicit

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rr As Range
    Dim r As Range
    Dim m

    Set rr = Intersect(Target, Columns(2))
    If rr Is Nothing Then Exit Sub

    Application.EnableEvents = False

    rr.Offset(, 1).Resize(, Columns.Count - 2).ClearContents

    For Each r In rr
        m = Application.Match(r, Rows(1), 0)
        If IsNumeric(m) Then
            r.EntireRow.Cells(m).Value = Format(r.Value, "m/d") & "出荷"
        Else
            r.ClearContents
        End If
    Next

    Application.EnableEvents = True

 End Sub

（マナ） 2018/05/27(日) 12:59

回答ありがとうございます。
Worksheet_Changeを使うのは分かってたのですが、まだ理解できていないのですが
このコードのままでは動かないですかね？
試してはみたのですが、エラーもなく何も起こらない状況です。
実際の表のセルの位置等は違いますが、例に書いた簡単な表を作って試しても同じ状況です。

（ten） 2018/05/27(日) 16:00

＞例に書いた簡単な表を作って試しても同じ状況です。

ポイントは、h付が１行目と２列目にあることです。

（マナ） 2018/05/27(日) 16:04

Set rr = ....の行にブレークポイントを置いて
ステップ実行して想定どおり動くか確認してみては？
（γ） 2018/05/27(日) 16:28

C2から右に日付が並び、B2から下に日付を入力しているのですが何も変わらない状況です。
Set rr = ....の行にブレークポイントを置いて、ステップイン？
カーソルまで実行等を行ったのですがエラーも出ず何も変化ありません。
（ten） 2018/05/27(日) 17:40

＞日付を入力しているのですが何も変わらない状況です。

B2に入力した日付は消えていませんか？

（マナ） 2018/05/27(日) 17:57

念のために確認しますが
シートモジュールと標準モジュールの違いはご存知ですよね。

（マナ） 2018/05/27(日) 18:01

標準モジュールに入力しているのですが、シートモジュールでは基本そのシートのみでの動作前提になってしまうとかでしょうか？
B2は下記のように日付は表示されています。
コードもすべてそのまま貼り付けたので、抜けはないと思うのですが・・・

品名出荷日 5/1 5/2 5/3

	5/2			
	5/1

（ten） 2018/05/27(日) 18:24

イベントプロシージャというものは、シートモジュールに書かないと動作しません。
＞Worksheet_Changeを使うのは分かってたのですが
って、どういうことでした？

（γ） 2018/05/27(日) 19:43

＞カーソルまで実行等を行ったのですがエラーも出ず何も変化ありません。
標準モジュールにおいて、どうやったら起動できるんでしょうか。
ほんとに実行したんですか？

（γ） 2018/05/27(日) 19:49

すみません。
最初シートモジュールに入力してて動かなかったため、標準モジュールに移動して試してました。
Worksheet_Changeを扱うのに標準モジュールで動くはずがないですね。
ただ、シートモジュールでも状況は変わらないので、ほかに原因があるかもしれません。
もうちょっと色々調べてみます。
（ten） 2018/05/27(日) 20:51

＞コードもすべてそのまま貼り付けたので、

貼り付けたシート以外では動作しませんよ。
他のシートということはありませんか？

（マナ） 2018/05/27(日) 21:24

新規に作成したファイルのみでも試してみたので、シート名が違う所でコードを入力してということも
ありません。
コードも間違いはないとは思いますが、
勉強不足で、rとrrの所の式がまだよく理解できていないので
そこら辺をもっと勉強しないと原因もつかめないかもしれません。
（ten） 2018/05/28(月) 02:09

 ＞各セルに　=IF(TEXT($B2,"m/d")=TEXT(D$2,"m/d"),TEXT($B2,"m/d")&"出荷","")と入力して同じようなことは出来ているのですが、
 ＞非常にデータ量が多く、よくExcelが15分以上止まってしまうことがある

 =IF(TEXT($B2,"m/d")=TEXT(C$1,"m/d"),TEXT($B2,"m/d")&"出荷","")
                         ~~↑~~
 　　　　　　　　　　　　ですよね？　そこが1行目じゃなかったら、話がズレます。

 あと、この方が少し軽いと思いますが、それにしても15分も止まるなんてことは考えられないです。
 　　　　↓
 C2セル =IF($B2="","",IF(TEXT($B2,"m/d")=TEXT(C$1,"m/d"),TEXT($B2,"m/d")&"出荷",""))

 一体、どんな広さなんですか？
  他に、揮発性関数(TODAYとかOFFSETとか）を大量に使っているなんて事は無いですか？

 いずれにしても、現在の数式で旨くいっていると言う事は、
 マナさんの想定するデータと違うと言う可能性もあります。

 なんたって、「5/1」ですからねぇ。
 その実体値は何なんだ、って問題が残ります。

 ※「そのまんまの文字列」なのか、「年度がお互い違う」のか・・・

 C1セルの書式を「標準」にするとどうなりますか？
 今年の5/1なら43221に変わるハズですが・・・

（半平太） 2018/05/28(月) 11:01

日付は実際には、S5から右に年内分の日付が入っており、
式は今のところS6からDT2117まで入ってます。
日付の所の書式設定はすべて日付にしてあり、
どちらも2018になっているので間違いはないと思うのですが。
（ten） 2018/05/28(月) 11:58

 ＞日付は実際には、S5から右に年内分の日付が入っており、

 当初の説明と違うレイアウトじゃないですか？
 　　　↓
 ＞製品ごとの出荷日を入力する列（B2以降）があり、C1からカレンダーのように日付が入力してあります。

 その部分をアジャストしなければ、オリジナルのコードで動かないのは当然ですけど、
 そのアジャストはやったんですか？

（半平太） 2018/05/28(月) 12:11

すみません。
最終に使用するレイアウトでは分かりにくいかと思い、
一部省いた簡単な表データを例にして、それで教えて頂いたものを自分で
変えようか考えてました。
私の実際のセルの位置だとコードも変える必要が有りそうですね。
実際の条件で提示すれば良かったですね。

最初教えて頂いたものは官僚化したレイアウトでしか試していないのですが、
どうも、visual basicの方でエラーか何かが一度起こった状態になって使用すると
動作しなくなる感じみたいです。
一度エクセルを閉じて、一から試すと問題なく表示されました。
エラー起きてデバッグ終了しますがエラーの場所によってそのまま動作する場合と
そうでない時があるようです。
（ten） 2018/05/28(月) 22:14

Application.EnableEvents が Falseになったままなのでしょう。
イミディエイトウインドウで、
Application.EnableEvents = True
を実行するとよいでしょう。
そうすると、イベントプロシージャが有効になると思います。

（γ） 2018/05/28(月) 22:19

よこから口出しですが、こちらの質問と似てる気がするのでもしかしたら参考になるかもです。
[[20180313225625]]　
（もこな２） 2018/05/28(月) 22:39

実際は２列目が出荷日でないなら

＞rr.Offset(, 1).Resize(, Columns.Count - 2).ClearContents

ここの２もそのままだと、エラーになっちゃいます。

（マナ） 2018/05/28(月) 22:58

とりあえず適当に大きい数字でたぶん大丈夫です。

rr.Offset(, 1).Resize(, 5000).ClearContents

（マナ） 2018/05/28(月) 23:08

実際は出荷日をK7から下に入れるのですが、columnsのところの2を11に変えるのはわかる
のですが、行の位置どう変えればいいでしょうか？
（ten） 2018/05/28(月) 23:28

他の質問と勘違いしていました。
１年分なら、多くて366列ですね。

＞行の位置どう変えればいいでしょうか？

Rows(6)としました。

 Option Explicit

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rr As Range
    Dim r As Range
    Dim m

    Set rr = Intersect(Target, Columns("K"))
    If rr Is Nothing Then Exit Sub

    Application.EnableEvents = False

    rr.Offset(, 1).Resize(, 366).ClearContents

    For Each r In rr
        m = Application.Match(r, Rows(6), 0)
        If IsNumeric(m) Then
            r.EntireRow.Cells(m).Value = Format(r.Value, "m/d") & "出荷"
        Else
            r.ClearContents
        End If
    Next
    Application.EnableEvents = True

 End Sub

（マナ） 2018/05/28(月) 23:40

ありがとうございます。
これでうまくいきそうなのですが、一つ問題があって
テーブルを設定しているのですが、日付などが入った行はフィルターを使用します。
そのため日付がテキスト形式になってしまうため、入力した出荷日が出ないようです。
出来れば新たに日付の行を増やしたくはないのですが、いい方法がありますでしょうか？
（ten） 2018/05/29(火) 06:55

これで。
ついでに、別のエラーの可能性も潰しておきました。

 Option Explicit

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tbl As Range
    Dim rr As Range
    Dim r As Range
    Dim m

    Set tbl = Range("L7").Resize(1000, 366)

    Set rr = Intersect(Target, tbl.Columns(0))
    If rr Is Nothing Then Exit Sub

    Application.EnableEvents = False

    Intersect(rr.EntireRow, tbl).ClearContents

    For Each r In rr
        m = Application.Match(r.Text, tbl.Rows(0), 0)
        If IsNumeric(m) Then
            r.Offset(, m).Value = Format(r.Value, "m/d") & "出荷"
        Else
            r.ClearContents
        End If
    Next

    Application.EnableEvents = True

 End Sub

（マナ） 2018/05/29(火) 07:42

上記ままでは動かないのですが
＞Set rr = Intersect(Target, tbl.Columns(0))
ここの0を("K")に変えますよね？
あと
＞m = Application.Match(r.Text, tbl.Rows(0), 0
のRows(0)を日付が並んでる5行目に変える必要がありますでしょうか？

これでやっては見たのですが表示されません。

（ten） 2018/05/29(火) 09:01

あと、日付出荷が表示されるセルは数字を入れることもあるのですが、
出荷日を入れると、その数字も消されてしまうので消えないようにできますでしょうか？
（ten） 2018/05/29(火) 09:57

 マナさんへ

 上の方で、こう云うレスがあったのですが、大丈夫ですか？
 　　　　　　↓
 ＞式は今のところS6からDT2117まで入ってます。 
 　　　　　　　　　　　~~↑~~
 　　　　　　　　多分、NT2117　だとは思いますが・・

 tenさんへ

 ＞日付出荷が表示されるセルは数字を入れることもある

 そちらの実状が分かりにくいです。

 取りあえず、マナさんのプロシージャを無効にして、 日付と数字を K6 と K7セルに一つずつ入力したあと、 
 下記マクロを当該シートモジュールに貼り付け→実行して、
 イミディエイトウィンドウに出てきた文字列をここにコピペして貰えませんか？

  Sub DATAcheck()
     Dim cel As Range
     For Each cel In Range("S5:T7,K6:K7")
         Debug.Print cel.Address & "→(型)" & TypeName(cel.Value) & "、 (式)" & _
         cel.FormulaLocal & "、(書式) " & cel.NumberFormatLocal
     Next
     Debug.Print "UsedRange → " & UsedRange.Address
  End Sub

 <出力例>　こんな感じに出てくると思いますが、果たして実際はどうなるのか・・

 $S$5→(型)Date、 (式)43221、(書式) m/d;@
 $T$5→(型)Date、 (式)43222、(書式) m/d;@
 $S$6→(型)Empty、 (式)、(書式) G/標準
 $T$6→(型)Empty、 (式)、(書式) G/標準
 $S$7→(型)Empty、 (式)、(書式) G/標準
 $T$7→(型)Empty、 (式)、(書式) G/標準
 $K$6→(型)Date、 (式)45236、(書式) m/d;@
 $K$7→(型)Double、 (式)600、(書式) G/標準
 UsedRange → $A$1:$NT$2122

（半平太） 2018/05/29(火) 10:29

試してみました。
$S$5→(型)String、 (式)5/28、(書式) m/d;@
$T$5→(型)String、 (式)5/29、(書式) m/d;@
$S$6→(型)String、 (式)=IF(TEXT($K6,"m/d")=TEXT(S$5,"m/d"),TEXT($K6,"m/d")&"出荷","")、(書式) 0%
$T$6→(型)String、 (式)=IF(TEXT($K6,"m/d")=TEXT(T$5,"m/d"),TEXT($K6,"m/d")&"出荷","")、(書式) 0%
$S$7→(型)String、 (式)=IF(TEXT($K7,"m/d")=TEXT(S$5,"m/d"),TEXT($K7,"m/d")&"出荷","")、(書式) G/標準
$T$7→(型)String、 (式)=IF(TEXT($K7,"m/d")=TEXT(T$5,"m/d"),TEXT($K7,"m/d")&"出荷","")、(書式) G/標準
$K$6→(型)Date、 (式)43249、(書式) m"月"d"日"
$K$7→(型)Double、 (式)200、(書式) G/標準
UsedRange → $A$1:$KC$2058

数字を入力するのは生産数量を入力するのですが、日付の出荷日を表示して
それまでにその数量を生産するという意味で、生産日に生産数を入れるようにしています。
なので基本は”日付出荷日”の左側に入力するイメージです。
（ten） 2018/05/29(火) 11:27

 ＞数字を入力するのは生産数量を入力するのですが、日付の出荷日を表示して 
 ＞それまでにその数量を生産するという意味で、生産日に生産数を入れるようにしています。 
 ＞なので基本は”日付出荷日”の左側に入力するイメージです。

 600を入力すると、8/22の列(もしあれば）に「8/22出荷」と出ると思うんですけど、
 いままで本当に大丈夫だったんですか？

 生産数量の「取り得る範囲」を限定しないとまずいと思うんですが？

（半平太） 2018/05/29(火) 14:14

 ＞ 生産数量の「取り得る範囲」を限定しないとまずいと思うんですが？

 今回は、マクロで処理するので、そこは気にする必要なかったです。　m(__)m

 これだけの情報があれば、マナさんがなんとかしてくれると思います(多分）ので、
 それまで、しばらくお待ちください。

（半平太） 2018/05/29(火) 14:36

ごめんなさい。まだよくわかっていません。

 １）K列の出荷日の入力欄は6行目から で間違いないですか？
 ２）出荷日欄の表示形式は、m/d ではなく、m月d日 なのですか。
 ３）5行目の日付は、L列でなく、S列から始まる で間違いないですか？
 ４）5行目の日付の表示形式は m月d日 ではなく、m/d なのですか。
 ５）L列からR列には、何が入力されているのですか
 ６）テーブルの設定範囲はどこですか
 ７）シート内にテーブルは１つですか

 ＞出荷日を入れると、その数字も消されてしまうので消えないようにできますでしょうか？

 ＞数字を入力するのは生産数量を入力するのですが、日付の出荷日を表示して 
 ＞それまでにその数量を生産するという意味で、生産日に生産数を入れるようにしています。 
 ＞なので基本は”日付出荷日”の左側に入力するイメージです

 ８）K列に出荷日を入力後、生産日に生産数を左隣に入力する順番ですか
 ９）出荷日の入力が後になることもあるのですか
 10）その場合、生産数が左隣にならないのでは？
 11）今までは、どうしていたのですか。生産数を入力すると数式が消えてしまいませんか？

（マナ） 2018/05/29(火) 18:46

1)7行目でお願いします。
2)表示形式はm/dです。
3)日付表示はL列から右です。
4)5行目もm/d表示です。
5)LからR列には備考欄や製品に関する様々な情報が入ります。
6)テーブル範囲は現在　=$A$5:$HZ$1281　となっていますが、
生産日程なので日々減ったり増えたりで行数は変わります。
7)テーブルは一つです。
8)9)10)11)新規入れ込みの時はほぼ同時ではありますが順番としてはそうなりますね。
出荷日を入れる列は生産までに納期変更する場合もあります。その場合は書き換えます。
生産数は出荷日の1日前やもっと前に設定する場合もあり、当日生産もあり得ます。
生産数の数字入力は、数式は消えますが無視して入力しています。
生産が終わればその行は消しこみますが、新規入れ込みの際はテーブル内なので行挿入で
式は自動で入ってきます。
また、同じ品名(行)で生産数が多い場合は分納とかもあり得ますので、最初の納期の後に生産数を入れることもあります。
生産が終わり、日が過ぎたものは、日付の列を消していきますのでS列がスタートで生産数入力もS列以降になります。
（ten） 2018/05/29(火) 20:11

まだ、わかりません。

 ＞1)7行目でお願いします。
 と
 ＞4)5行目もm/d表示です。
 ＞6)テーブル範囲は現在　=$A$5:$HZ$1281　となっていますが、

矛盾していませんか？
では、６行目は何があるのでしょうか。

 ＞3)日付表示はL列から右です。 
 と
 ＞5)LからR列には備考欄や製品に関する様々な情報が入ります。

これも矛盾しているように思われますが？
日付表示はS列から右ではないのでしょうか。

 ＞出荷日を入れる列は生産までに納期変更する場合もあります。その場合は書き換えます。

であれば、

 ＞出荷日を入れると、その数字も消されてしまう

そのほうが良いのでは？
あれるいは、出荷日入力欄（K列）の横に、生産数入力欄を作り、
こちらも自動で転記させるとか。

（マナ） 2018/05/29(火) 20:32

すみません。
3)の日付はS列から間違いです。
6行目にはA6に、製品の種別のようなタイトルが入ってるため
B6以降の右は空白になっています。

出荷日を入れると、その数字も消されてしまうの意味は、出荷日を入力し直したりすると、入力していた生産数も消えてしまうので
日付出荷の表示だけをリセットする仕様にして欲しいです。
生産数が入った列も別ありますが、実際生産する日は手動の方がいいです。
（ten） 2018/05/29(火) 21:31

これでどうですか？
数値は消さないようにしました。

 Option Explicit

 Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tbl As Range
    Dim 出荷日 As Range
    Dim 転記領域 As Range
    Dim rr As Range
    Dim r As Range
    Dim m

    Set tbl = ListObjects(1).DataBodyRange
    Set 出荷日 = tbl.Columns("K")
    Set 転記領域 = Intersect(tbl, tbl.Offset(, Columns("S").Column - 1))

    Set rr = Intersect(Target, 出荷日)
    If rr Is Nothing Then Exit Sub

    Application.EnableEvents = False

    On Error Resume Next
    Intersect(rr.EntireRow.SpecialCells(xlCellTypeConstants, 2), 転記領域).ClearContents
    On Error GoTo 0

    For Each r In rr
        m = Application.Match(r.Text, tbl.Rows(0), 0)
        If IsNumeric(m) Then
            r.EntireRow.Cells(m).Value = Format(r.Value, "m/d") & "出荷"
        Else
            r.ClearContents
        End If
    Next

    Application.EnableEvents = True

 End Sub

（マナ） 2018/05/29(火) 22:00

マナさんありがとうございます。
思い通りの動作でうまくいきそうです。
式はまだ全部削除しきれてませんがファイルの容量も大分減りました。
セル挿入とかで動作が重くよく止まっていたのですが、その辺の確認はこれから
みてみます。
変更後、一度何かの拍子に動かなくなり強制終了しなければならなくなったのですが
もうちょっと様子みてみます。
もしまた何かありましたらよろしくお願いします。
長々とありがとうございました。
（ten） 2018/05/30(水) 07:47

コメント返信：

[ 一覧(最新更新順) ]

[[20180527115856]] 『入力した日付をと一致する交点に入力するマクロ』（ten） ページの最後に飛ぶ

[[20180527115856]]　『入力した日付をと一致する交点に入力するマクロ』（ten）　ページの最後に飛ぶ