[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『空白&「/」』(師走)
お世話になります。 退職された方が作った物でマクロが組み込んであります。 私はマクロ記録しかわからないので、お知恵お願いいたします。
・トラックのNoプレ−ト 32-45あるいは43-65を選択したら空白 それ以外なら「/」が入る。
・1年分のシ−トなので納入先の変動で毎日、配車が変わります。 範囲は トラックのNoプレ−トはC7〜 空白または「/」はN7〜
宜しくお願い致します。
< 使用 Excel:Excel2010、使用 OS:Windows7 >
その説明は現在のマクロがそうなっているということなのか? それとも現在のマクロにそういった機能を追加したいということなのだろうか?
何を質問したいのかを具体的に書いてくれ。 (ねむねむ) 2016/12/06(火) 09:27
処理対象のシートのレイアウトを具体的に説明いただくと要件も理解しやすいのですが 往々にして、その説明が不足していて、そのためのQ/Aが続く場合がありますので、まずは 現在のコードを そのまま(抜粋せず、また手打ちせず)コピペでアップしてみたらどうでしょうか。
(β) 2016/12/06(火) 09:31
ねむねむさん、βさん ありがとうございます。質問が不足していようですいません。
ブック内の A社、B社、C社の3つのシ−トにトラックのNoプレ−トを入力しております。 例 A社のシ−ト C7に12-34を選択したらN7に「/」が入るように C7に32-45あるいは43-65を選択したらN7は空白
現在入っているコ−ドですが This Workbook(30分で閉じる)に
Option Explicit
'==================================================================================== Const e_tm = "終了時刻" '==================================================================================== Private Sub Workbook_BeforeClose(Cancel As Boolean) On Error Resume Next Application.OnTime EarliestTime:=get_cdp(e_tm).Value, Procedure:="thisworkbook.end_proc", Schedule:=False On Error GoTo 0 End Sub '==================================================================================== Private Sub Workbook_Open() Dim tm As Date tm = Now() + TimeValue("00:30:00") If mk_cdp(e_tm, msoPropertyTypeDate, tm) <> 0 Then get_cdp(e_tm).Value = tm End If Application.OnTime EarliestTime:=get_cdp(e_tm).Value, Procedure:="thisworkbook.end_proc" Sheets("変更・追加").Protect UserInterfaceOnly:=True End Sub '==================================================================================== Sub end_proc() ThisWorkbook.Close True End Sub '====================================================================== Function mk_cdp(pnm As Variant, mytype As MsoDocProperties, myvalue) On Error Resume Next With ThisWorkbook .CustomDocumentProperties.Add pnm, False, mytype, myvalue End With mk_cdp = Err.Number On Error GoTo 0 End Function '====================================================================== Function get_cdp(pnm As String) As DocumentProperty Dim cp As DocumentProperty Set get_cdp = Nothing For Each cp In ThisWorkbook.CustomDocumentProperties If cp.Name = pnm Then Set get_cdp = cp Exit For End If Next End Function
変更・追加のシ−ト(レ点)に Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If (Target.Rows.Count <> 1) Or (Target.Columns.Count <> 1) Then Exit Sub If Intersect(Range("H6:H5000,J6:J5000,M6:M5000"), Target) Is Nothing Then Exit Sub Application.EnableEvents = False If Target.Value = "" Then Target.Value = ChrW(9745) Else Target.Value = IIf(AscW(Target.Value) = 9745, ChrW(9744), ChrW(9745)) End If Cancel = True Application.EnableEvents = True End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Intersect(Target, Range("A6:M1000")) Is Nothing Then Exit Sub Dim r As Range Application.EnableEvents = False For Each r In Intersect(Target, Range("A6:M1000")) If IsDate(r.Value) = True Then r.Offset(, 1).Value = Time If r.Value = "" Then r.Offset(, 1).ClearContents Next Application.EnableEvents = True End Sub
Sub Auto_Open()
Sheets("変更・追加").Protect UserInterfaceOnly:=True End Sub
宜しくお願い致します。
(師走) 2016/12/06(火) 10:12
このコード、すべて ThisWorkbookモジュールに記載されているのですか? どう見ても シートモジュールのコードや標準モジュールのコードが混在しているように見受けられますが。
それと、 Private Sub Workbook_Open() と Sub Auto_Open() なぜ、この2つが登場しているのでしょう? (何か意図があれば、だめということではないですが)
(β) 2016/12/06(火) 10:22
βさん ごめんなさい。よくわからないです。 私としては、コ−ピして貼り付けただけなので!
ThisWorkbookモジュールには時間で閉じるコ−ドだけです。(たぶん)
Sheet1(変更・追加) モジュールに レ点のコ−ドだと思います。
(師走) 2016/12/06(火) 10:37
師走さんの書き込みで
>This Workbook(30分で閉じる)に
>変更・追加のシ−ト(レ点)に とどこにあるかが書かれているように思えるが。
もっとも >Sub Auto_Open() はワークシートモジュールではなく標準モジュールではないかと思うが。 (ねむねむ) 2016/12/06(火) 10:51
ねむねむさん ありがとうございます。
Sub Auto_Open() もSheet1(変更・追加) モジュールにかかれています。 必要ないのでしょうか???
(師走) 2016/12/06(火) 11:06
Sub Auto_Open() これがワークシートモジュールにあるとすると、そのシート上のボタンか何かでそのマクロが呼び出されているのだろうか?
もし、どこからも呼び出されていない場合、そのプロシージャは何の働きもしていないことになる。
通常Auto_Openという名前のプロシージャは標準モジュールに作成することでブックが開かれた際に自動実行されるようになっている。 (ThisWorkbooモジュールのWorkbook_Open()と同じような機能)
(ねむねむ) 2016/12/06(火) 11:17
ねむねむさん 説明ありがとうございます。 ボタンはないです。 必要なさそうですね。 ありがとうございます。
浅はかな考えなのですが(お叱りの言葉を受けるかも) 例えば A社のシートモジュールに C7:C1000にトラックのNoプレ−ト 32-45あるいは43-65を選択したら N7:N1000に空白 C7:C1000にトラックのNoプレ−ト 32-45・43-65以外を選択したら N7:N1000に「/」が入る。
横展開で B社のシートモジュールとC社のシートモジュールも同様
どうなんでしょうか?
(師走) 2016/12/06(火) 11:35
とりあえず、コードをざらっと流し読みをしてみました。
ThisWorkbookモジュールに書かれている
Private Sub Workbook_Open と Private Sub Workbook_BeforeClose(Cancel As Boolean) および そこで使われている end_proc、mk_cdp、get_cdp の3つは、今回のテーマには関係しないので無視します。
ただ、どこに書かれているかは不明ですが Auto_Open 、ここでやっていることは 変更・追加 という名前の保護されたシートに対してマクロからは処理できるような設定をしているだけで かつ、この処理は Workbook_Open でも実行されていますので、Ayto_Open は不要です。 消しておかれることを推奨します。
アップされたコードがすべてであれば、どこにも、この 変更・追加 シートにマクロから書きこんでいる 部分がないので、なんのための処理なのかは見当がつきませんが、今回のテーマとは関係ない(と思われる) ので、深く考えないことにします。
で、残りのコード、 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) と Private Sub Worksheet_Change(ByVal Target As Range) ですけど、これらは A社、B社、C社の それぞれのシートモジュールに同じものが書かれているんでしょうね。(推測dす) もし、これらのコードが 変更・追加シートのシートモジュールに書かれているとすれば、以下のコメントは 間違ったコメントになります。
これらのコードでしていることは
H6:H5000,J6:J5000,M6:M5000 の範囲内で、単一セルの右クリック選択があった時、そのセルにレ点を付けたり レ点を消したりしています。
また、A6:M1000 の範囲内に日付型のデータが入力されたら、その右横のセルに現在時刻をセット。 その範囲内の入力が空白なら その右横のセルもクリア。日付型、空白 いずれでもない 通常の入力なら何もしていません。
で、今回のテーマ、現在の機能に「つけくわえる」のですね? 横展開というのは A社でもB社でもC社でも、そういったことをしたいということですね。
この理解に基づいてコードを書いて、書き上げたらアップしますが、違っていれば、早めに、違うと 言ってくださいね。
(β) 2016/12/06(火) 14:45
↑の回答をもらって居ない状態で見切り発車ですので、一抹の不安はありますが。 今回の手当ては Changeイベントの見ですので、BefreRightClick は今のままでもいいのですが 1つのシートに対する処理が、シートモジュールとThisWorkbookモジュールに混在するのは 好ましくないので ThisWorkbookモジュールに一本化します。
ただ、シートに対する処理は 入力、右クリックの既存処理が2つ、あたらしい入力処理が1つ。 都合、3つの処理になりますが、それぞれの処理で相手にしている対象領域が、重なっているというところに 違和感を覚えます。
●現在の A社、B社、C社の 各シートモジュールの
Worksheet_BeforeRightClick プロシジャと Worksheet_Change プロシジャを すべて消してください。 で、 ThisWorkbookモジュールに以下を追加してください。 対象のシート名は ★印で判定(2か所)していますので、ここは実際のものに直してください。
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim r As Range Dim a As Range
Select Case Sh.Name Case "A社", "B社", "C社" '★対象シート名
'既存の処理部分 Set a = Intersect(Target, Range("A6:M1000")) If Not a Is Nothing Then Application.EnableEvents = False For Each r In a If IsDate(r.Value) = True Then r.Offset(, 1).Value = Time If r.Value = "" Then r.Offset(, 1).ClearContents Next Application.EnableEvents = True End If
'今回の追加部分 Set a = Intersect(Target, Range("C7:C1000")) If Not a Is Nothing Then Application.EnableEvents = False For Each r In a Select Case r.Value Case "32-45", "43-65" r.EntireRow.Columns("N").ClearContents Case Else r.EntireRow.Columns("N").Value = "/" End Select Next Application.EnableEvents = True End If
End Select End Sub
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
If Target.Count <> 1 Then Exit Sub If Intersect(Range("H6:H5000,J6:J5000,M6:M5000"), Target) Is Nothing Then Exit Sub
Select Case Sh.Name Case "A社", "B社", "C社" '★対象シート名
Application.EnableEvents = False If Target.Value = "" Then Target.Value = ChrW(9745) Else Target.Value = IIf(AscW(Target.Value) = 9745, ChrW(9744), ChrW(9745)) End If Cancel = True Application.EnableEvents = True
End Select
End Sub
(β) 2016/12/06(火) 15:20
βさん お返事が遅くなり申し訳ないです。
今、お家なので わかる範囲でお答えさせていただきますね。
>Ayto_Open は不要です。 消しておかれることを推奨します。
明日消しますね。
>A社、B社、C社の それぞれのシートモジュールに同じものが書かれているんでしょうね。
A社、B社、C社の それぞれのシートモジュールには、何も書いてありません。
>横展開というのは A社でもB社でもC社でも、そういったことをしたいということですね。
その通りです。
早くお返事をすればよかったのですが コードの作成 心から感謝と申し訳なさが混同しております。
(師走) 2016/12/06(火) 18:49
>>A社、B社、C社の >>それぞれのシートモジュールには、何も書いてありません。
えっ!!
では、アップされた
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
と
Private Sub Worksheet_Change(ByVal Target As Range)
は、どこに書いてあるんですか??
(β) 2016/12/06(火) 19:17
βさん お返事ありがとうございます。 恐縮しております。
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) と Private Sub Worksheet_Change(ByVal Target As Range)
は Sheet1(変更・追加) モジュールにかいてあります。
(師走) 2016/12/06(火) 19:26
書き込んであるコードを区切って コピペしたほうがよかったかもしれませんね。 βさんを悩まさせて ごめんなさい。 (師走) 2016/12/06(火) 19:31
であれば、アップしたものは、いったん 忘れてください。 つまり Sheet1(変更・追加) モジュール は、そのままにして、 THisWorkbookモジュールに追加するのは以下のみです。
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim r As Range Dim a As Range
Select Case Sh.Name Case "A社", "B社", "C社" '★対象シート名
Set a = Intersect(Target, Range("C7:C1000")) If Not a Is Nothing Then Application.EnableEvents = False For Each r In a Select Case r.Value Case "32-45", "43-65" r.EntireRow.Columns("N").ClearContents Case Else r.EntireRow.Columns("N").Value = "/" End Select Next Application.EnableEvents = True End If
End Select End Sub
(β) 2016/12/06(火) 20:56
βさん 再度作っていただきましてありがとうございますね。 明日 早々に社にて使わせてもらいます。 明日 お返事させてもらいます。
おやすみなさいませ。 (師走) 2016/12/06(火) 21:27
βさん おはようございます。
思った通りの動作はしてくれるのですが 例えば C7にトラックのNoプレ−ト「12-34」を選択するとN7に「/」が入るのはよいのですが 間違って その日の納入トラックがないのに気付いてC7を空白にしても「/」は残ってしまいます。 また 最初にC7の空白を選択しても「/」が出てしまいます。
C7:C1000が空白の場合、「/」が出ないようお願いできないでしょうか 宜しくお願い致します。
(師走) 2016/12/07(水) 09:23
Case "32-45", "43-65"
これを
Case "32-45", "43-65", Empty
に変えてください。
(β) 2016/12/07(水) 09:31
βさん 早々の対応ありがとうございます。
βさんのお力沿いにて やったと笑みがこぼれてしまいました私です。 今後とも宜しくお願い致しますね。
無知な私から感謝をこめて! 風邪などひかないように自愛くださいませ。
(師走) 2016/12/07(水) 09:46
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.