Results of 1 - 1 of about 37668 for IF (0.008 sec.)
- [[20170410161206]]
- #score: 1591
- @digest: cc1726860caf9eb470c3c4813e0311b8
- @id: 73208
- @mdate: 2017-04-11T06:11:39Z
- @size: 11187
- @type: text/plain
- #keywords: ル代 (119879), 入. (50325), satosi (37191), 入in (27628), h500 (25243), 入as (24234), c500 (15525), 算日 (9996), 代入 (9797), 起算 (9205), 計対 (8408), enableevents (8029), c20 (7844), dateserial (6624), intersect (5451), 力不 (4885), target (4228), vbcrlf (4187), 象外 (3679), ル以 (2933), isempty (2862), （sa (2840), application (2803), nothing (2741), 2017 (2618), 以前 (2384), 単独 (2264), date (2065), 動作 (1934), カリ (1854), 不可 (1693), ーニ (1671)
- 『Worksheet_Change連結について』（satosi）
マクロ初心者です。 プロシージャが2つあり、つなぎ方だと思いますが ======から下が動作してくれません? アドバイスお願いします。 Private Sub Worksheet_Change(ByVal Target As Range) Dim セル代入 As Range With Target If .Count > 1 Then Exit Sub If .Value = "" Then Exit Sub If Intersect(Target, Range("C20:C500")) Is Nothing Then Exit Sub If .Value < Range("C20").Value Then MsgBox "日付が起算日（C20セル）以前です?確認してください。" _ & vbCrLf & vbCrLf & "C28セル以前は集計対象外になるため入力不可です。" Application.EnableEvents = False .Value = "" Application.EnableEvents = True End If End With ==================== If Intersect(Target, Range("H20:H500")) Is Nothing Then Exit Sub End If Application.EnableEvents = False For Each セル代入 In Target If IsEmpty(セル代入.Value) Then セル代入.Offset(, -5).ClearContents Else If セル代入.Offset(, -5).Value = "" Then If Day(Date) >= 8 Then セル代入.Offset(, -5).Value = Format(DateSerial(Year(Date), Month(Date) + 1, 5), "gee.mm.dd") Else セル代入.Offset(, -5).Value = Format(DateSerial(Year(Date), Month(Date), 5), "gee.mm.dd") End If End If End If Next Application.EnableEvents = True End Sub よろしくお願いします。 ＜ 使用 Excel:Excel2016、使用 OS:Windows10 ＞ ---- ↓の条件に合致したからExit Subしているのでは? If Intersect(Target, Range("H28:H500")) Is Nothing Then Exit Sub End If 動作していない、というのはどのように確認されましたか? （カリーニン） 2017/04/10(月) 16:26 ---- 参考になると思います。 http://kabu-macro.com/vba_apply/vba_ifthen.html （カリーニン） 2017/04/10(月) 16:29 ---- そもそも >If Intersect(Target, Range("C20:C500")) Is Nothing Then Exit Sub この条件でRange("H20:H500")の範囲は最初のうちに終了になってしまうが。 （ねむねむ） 2017/04/10(月) 16:31 ---- （カリーニン）さん ありがとうございます。 ＞動作していない、というのはどのように確認されましたか? H列に実際に、入力をすれば C列に自動で日付が入ります。 以下のように上部分を消去し、実行すると動作します。 この説明でわかりますか?どっちも単独では動作します。 よろしくお願いします。 Private Sub Worksheet_Change(ByVal Target As Range) Dim セル代入 As Range If Intersect(Target, Range("H20:H500")) Is Nothing Then Exit Sub End If Application.EnableEvents = False For Each セル代入 In Target If IsEmpty(セル代入.Value) Then セル代入.Offset(, -5).ClearContents Else If セル代入.Offset(, -5).Value = "" Then If Day(Date) >= 8 Then セル代入.Offset(, -5).Value = Format(DateSerial(Year(Date), Month(Date) + 1, 5), "gee.mm.dd") Else セル代入.Offset(, -5).Value = Format(DateSerial(Year(Date), Month(Date), 5), "gee.mm.dd") End If End If End If Next Application.EnableEvents = True End Sub 以下も単独なら動きます。 Private Sub Worksheet_Change(ByVal Target As Range) With Target If .Count > 1 Then Exit Sub If .Value = "" Then Exit Sub If Intersect(Target, Range("C20:C500")) Is Nothing Then Exit Sub If .Value < Range("C20").Value Then MsgBox "日付が起算日（C20セル）以前です?確認してください。" _ & vbCrLf & vbCrLf & "C20セル以前は集計対象外になるため入力不可です。" Application.EnableEvents = False .Value = "" Application.EnableEvents = True End If End With End Sub （satosi） 2017/04/10(月) 16:40 ---- 'こんな風につなげてみたらどうですか? Private Sub Worksheet_Change(ByVal Target As Range) Dim セル代入 As Range With Target If .Count > 1 Then Exit Sub If .Value = "" Then Exit Sub End With If Intersect(Target, Range("C20:C500"), Range("H20:H500")) Is Nothing Then Exit Sub If Not Intersect(Target, Range("C20:C500")) Is Nothing Then With Target If .Value < Range("C20").Value Then MsgBox "日付が起算日（C20セル）以前です?確認してください。" _ & vbCrLf & vbCrLf & "C28セル以前は集計対象外になるため入力不可です。" Application.EnableEvents = False .Value = "" Application.EnableEvents = True End If End With Else Application.EnableEvents = False For Each セル代入 In Target If IsEmpty(セル代入.Value) Then セル代入.Offset(, -5).ClearContents Else If セル代入.Offset(, -5).Value = "" Then If Day(Date) >= 8 Then セル代入.Offset(, -5).Value = Format(DateSerial(Year(Date), Month(Date) + 1, 5), "gee.mm.dd") Else セル代入.Offset(, -5).Value = Format(DateSerial(Year(Date), Month(Date), 5), "gee.mm.dd") End If End If End If Next Application.EnableEvents = True End If End Sub （半平太） 2017/04/10(月) 16:42 ---- （半平太）さん ありがとうございます。 ＞ Else以下 動作してくれませんでした。? 2017/04/10(月) 16:40コメントです 単独なら動くのですが・・・ （satosi） 2017/04/10(月) 16:51 ---- ＞ With Target ＞ If .Count > 1 Then Exit Sub ＞ If .Value = "" Then Exit Sub ＞ If Intersect(Target, Range("C20:C500")) Is Nothing Then Exit Sub ＞ If .Value < Range("C20").Value Then ＞ MsgBox "日付が起算日（C20セル）以前です?確認してください。" _ ＞ & vbCrLf & vbCrLf & "C20セル以前は集計対象外になるため入力不可です。" ＞ Application.EnableEvents = False ＞ .Value = "" ＞ Application.EnableEvents = True ＞ End If ＞ End With ↑このコード、セルにロックかけて触れなくしたら要らなくないですか? もっとちゃんと作業の手順をコードにして書かないとだめかも? まずは日本語でちゃんと説明してみましょう。 VBA語に翻訳は皆さんが手伝ってくれると思うので。 （まっつわん） 2017/04/10(月) 17:00 ---- （まっつわん）さん ありがとうございます。 ＞もっとちゃんと作業の手順をコードにして書かないとだめかも? すみません。つなぎだけだったので皆さんならお解り頂けるかなと 思ってしまいました 帳票は以下です C D E F G H 日付 コード 金額 20 H29.4.5 12 12000 21 15 2000←ここへ入力時C列へ日付 D列にコード E列:コードから会社名呼びだし自動挿入 F.Gも同様です H列に数値（金額）を入力した時点でC列に日付を代入するマクロです。 また最初のプロシージャはC列途中に修正等で日付を変更する場合があり C20より以前の日付を入れた場合注意をうながすマクロです。 以上簡単ですが動作説明です。 （まっつわん） さん解りますか? （satosi） 2017/04/10(月) 17:17 ---- ＞（まっつわん） さん解りますか? なるほど、了解です。 でも、メッセージボックスで注意を促したところで、 何となくOK押したらそれっきりですよね? 条件付き書式設定で、セルの塗りつぶしの色を変える方が個人的には好きです。 （まっつわん） 2017/04/10(月) 22:42 ---- ごめんなさい。 簡単な事と思って、動作確認しないでアップしちゃいました。 上案の以下のステートメントを変更してください。 ＞ If Intersect(Target, Range("C20:C500"), Range("H20:H500")) Is Nothing Then Exit Sub ↓ へ変更 If Intersect(Target, Range("C20:C500,H20:H500")) Is Nothing Then Exit Sub （半平太） 2017/04/10(月) 23:09 ---- （まっつわん）さん ＞何となくOK押したらそれっきりですよね? 入力されてOK押してもクリアしますので問題ないかと・・・ （半平太）さん えっ くくらないと駄目なんですか ずっ〜と色々解らないながら悩んでいたのに一瞬で解決しました。 ありがとうございました。 （satosi） 2017/04/11(火) 00:02 ---- なるほど、、、、 条件を追加するならElseIfで追加したらいいと思います。 Private Sub Worksheet_Change(ByVal Target As Range) Dim セル代入 As Range Dim c As Range Dim m As Long Dim v As Variant If Target.CountLarge > 1 Then Exit Sub If Intersect(Target, Range("C20:C500")) Is Nothing Then If Target.Value < Range("C20").Value Then MsgBox "日付が起算日（C20セル）以前です?確認してください。" _ & vbCrLf & vbCrLf & "C28セル以前は集計対象外になるため入力不可です。" Application.EnableEvents = False Application.Undo Application.EnableEvents = True End If '==================== ElseIf Intersect(Target, Range("H20:H500")) Is Nothing Then Application.EnableEvents = False For Each セル代入 In Intersect(Target, Range("H20:H500")).Cells Set c = セル代入.Offset(, -5) If IsEmpty(セル代入.Value) Then v = Empty Else If IsEmpty(c.Value) Then If Day(Date) >= 8 Then m = Month(Date) + 1 Else m = Month(Date) End If v = Format(DateSerial(Year(Date), m, 5), "gee.mm.dd") End If End If c.Value = v Next End If Application.EnableEvents = True End Sub （まっつわん） 2017/04/11(火) 09:05 ---- （まっつわん）さん ありがとうございます。 ＞条件を追加するならElseIfで追加したらいいと思います。 了解いたしました。試してみます。 尚、作成いただきましたマクロですが D.F.Hどこに入力してもWorksheet_Changeチェンジイベントが発生してしまいます。 また日付も挿入出来ませんでした。 自分なりに変更はしてみたのですが変化ありません。? （satosi） 2017/04/11(火) 12:52 ---- >If Intersect(Target, Range("C20:C500")) Is Nothing Then と >ElseIf Intersect(Target, Range("H20:H500")) Is Nothing Then の部分は半平太さんのVBAにあるように >If Not Intersect(Target, Range("C20:C500")) Is Nothing Then >ElseIf Not Intersect(Target, Range("H20:H500")) Is Nothing Then ではないのか? （ねむねむ） 2017/04/11(火) 13:08 ---- （ねむねむ）さん ありがとうございます。 一応入力は出来ましたが。今度は Application.EnableEvents = False Application.Undo★ Application.EnableEvents = True 無理矢理以前の日付を入力するとUndoメゾットは失敗しました。とでて Excelが動作しなくなります、また同様に日付（C列）をdeleteしても出来なくなります。? マクロは難しいですぅ。 （satosi） 2017/04/11(火) 13:20 ---- >Excelが動作しなくなります これだけ。 >Application.EnableEvents = False はこれ以降EnableEventsにTrueが設定されるかExcel本体が終了するまでイベントの発生を抑制する。 なのでイミディエイトウィンドウで Application.EnableEvents = True と入力してEnterを押すかいったんExcelを終了させてみてくれ。 （ねむねむ） 2017/04/11(火) 13:26 ---- （ねむねむ）さん できました Falseでしたね。 ありがとうございました。 （satosi） 2017/04/11(火) 15:11... - http://www.excel.studio-kazu.jp/wiki/kazuwiki/201704/20170410161206.txt - [detail] - similar
PREV
NEXT
Powered by Hyper Estraier 1.4.13, with 97014 documents and 608133 words.
訪問者：