Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
3826 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【59961】行のカットと挿入について タケタケ 09/1/21(水) 9:59 質問[未読]
【59962】Re:行のカットと挿入について ひげくま 09/1/21(水) 12:19 発言[未読]
【59963】Re:行のカットと挿入について にぃ 09/1/21(水) 13:53 発言[未読]
【59971】Re:行のカットと挿入について タケタケ 09/1/21(水) 20:29 発言[未読]
【59976】Re:行のカットと挿入について にぃ 09/1/22(木) 9:47 発言[未読]
【59982】Re:行のカットと挿入について タケタケ 09/1/22(木) 12:46 お礼[未読]
【59984】Re:行のカットと挿入について にぃ 09/1/22(木) 13:29 発言[未読]
【59986】Re:行のカットと挿入について タケタケ 09/1/22(木) 17:53 質問[未読]
【59987】Re:行のカットと挿入について ダースベーロー 09/1/22(木) 18:03 発言[未読]
【60001】Re:行のカットと挿入について にぃ 09/1/23(金) 9:19 発言[未読]
【60002】Re:行のカットと挿入について タケタケ 09/1/23(金) 10:30 お礼[未読]
【60003】Re:行のカットと挿入について にぃ 09/1/23(金) 10:38 発言[未読]
【59961】行のカットと挿入について
質問  タケタケ  - 09/1/21(水) 9:59 -
引用なし
パスワード
   はじめまして、VBA初心者です。よろしくお願いします。

下記のようなデータがあります。
　　　A　　　　　　B　　　　　C　　　D　　　　 E　　　　F
1　 発注日　　　納入日　　　名称　　数量　　　単価　　請求書C
2　01月15日　　01月20日　　バルブ　　1　　　 1500　　　 C（セル色がピンク）
3　01月19日　　01月22日　　リレー　　2　　　 5200　　　 C（セル色がピンク）
4　01月21日　　　　　　　　ねじ　　　2　　　 100
5　01月31日　　　　　　　　ワッシャ　5　　　 200　　　
6　02月13日　　　　　　　　砥石　　　1　　　14800　　　

請求書CのF列セルにC文字を入力すると、
以下のイベントが起きるようにしたいです。
1.C入力セルの色がピンク色に変わる
2.C入力セルの行をカットする
3.対象行以上の上段行でC文字が入力されている行の下に挿入する
※後でCを削除する可能性があります。その時はイベント発生させずに、その行を維持したいです。

例えば、F5にC入力すると下記になるようにしたいです。
　　　A　　　　　　B　　　　　C　　　D　　　　 E　　　　F
1　 発注日　　　納入日　　　名称　　数量　　　単価　　請求書C
2　01月15日　　01月20日　　バルブ　　1　　　 1500　　　 C（セル色がピンク）
3　01月19日　　01月22日　　リレー　　2　　　 5200　　　 C（セル色がピンク）
4　01月31日　　02月10日　　ワッシャ　5　　　 200　　　　C（セル色がピンク）
5　01月21日　　　　　　　　ねじ　　　2　　　 100
6　02月13日　　　　　　　　砥石　　　1　　　14800　　　

当方でも、下記まで作成しましたが、エラーとなり断念しました。
※セル色変更とC文字入力でイベント発生は考慮してません。

Private Sub Worksheet_Change(ByVal Target As Range)

　　With Target
　　If .Row < 4 Then Exit Sub
　　If .Column <> 10 Then Exit Sub
　　
　　If .Value <> "" Then
　　.EntireRow.Cut
　　.Offset(0, 0).Activate
　　　　
　　.End(xlUp).Offset(1).Activate
　　.EntireRow.Insert Shift:=xlDown
　　
　　End If

　　End With
　　
End Sub

大変申し訳ありませんが、
みなさんのご教授を頂きたく、よろしくお願いします。
【59962】Re:行のカットと挿入について
発言  ひげくま  - 09/1/21(水) 12:19 -
引用なし
パスワード
   こんにちは。

▼タケタケ さん：
>当方でも、下記まで作成しましたが、エラーとなり断念しました。

このプログラムのどこでエラーになるのかも書きましょうね。

>※セル色変更とC文字入力でイベント発生は考慮してません。

C文字入力でイベント発生させるんじゃないんですか？
【59963】Re:行のカットと挿入について
発言  にぃ  - 09/1/21(水) 13:53 -
引用なし
パスワード
   ▼タケタケ さん：
こんにちは！

>※後でCを削除する可能性があります。その時はイベント発生させずに、その行を維持したいです。
後で？？
どのような「後で」でしょう？

コード内ですが
>　　.Offset(0, 0).Activate
これは、すでにアクティブになっているセルをアクティブにする処理ですよ。
なのでこれは必要ないのでは？

行の挿入でしたらこんな感じでしょうか。　　　　
>　　.EntireRow.Insert Shift:=xlDown
↓
Rows(ActiveCell.Row).Insert Shift:=xlDown
　　
あとは挿入作業でChangeイベントが発生してしまうので
Application.EnableEvents = False
Application.EnableEvents = True
を入れてあげたほうがいいかもしれません。

また、他にもエラーになりうる可能性がありそうですが、
詳しく状況がわからないのでひとまずここまで^^;
【59971】Re:行のカットと挿入について
発言  タケタケ  - 09/1/21(水) 20:29 -
引用なし
パスワード
   ▼ひげくま さん：
▼にぃ さん：
早速のご返信ありがとうございます。
ご教授どおり、下記コードにて再チャレンジしてみました。

Private Sub Worksheet_Change(ByVal Target As Range)

　　With Target
　　If .Row < 4 Then Exit Sub
　　If .Column <> 10 Then Exit Sub
　　
　　Application.EnableEvents = False
　　
　　If .Value = "c" Then
　　.Interior.ColorIndex = 44

　　End If
　　
　　If .Value = "c" Then
　　.EntireRow.Cut

　　.End(xlUp).Offset(1).Activate
　　Rows(ActiveCell.Row).Insert Shift:=xlDown
　　
　　End If

　　End With
　　
　　Application.EnableEvents = True
　　
End Sub

エラー無く動くのですが、Cが既に入ってる上段行の下の行に入力すると（下記F4セルにCを入力すると）1行目にカット行が挿入されてしまいます。
　　　A　　　　　　B　　　　　C　　　D　　　　 E　　　　F
1　 発注日　　　納入日　　　名称　　数量　　　単価　　請求書C
2　01月15日　　01月20日　　バルブ　　1　　　 1500　　　 C（セル色がピンク）
3　01月19日　　01月22日　　リレー　　2　　　 5200　　　 C（セル色がピンク）
4　01月21日　　　　　　　　　　ねじ　　　2　　　 100
5　01月31日　　　　　　　　　　ワッシャ　5　　　 200　　　
6　02月13日　　　　　　　　　　砥石　　　1　　　14800　

また、F列セルのDELETEするとエラーがでます（例えば、F2:F3セル選択で削除）。

なお上記コードで他にもエラーになりうる可能性がありますでしょうか？

よろしくお願いします。
【59976】Re:行のカットと挿入について
発言  にぃ  - 09/1/22(木) 9:47 -
引用なし
パスワード
   ▼タケタケ さん：
おはようございます！

コード内ですが、わざわざ2回も　　
>　　If .Value = "c" Then
で分岐しなくても1回でいいですよ。

>また、F列セルのDELETEするとエラーがでます（例えば、F2:F3セル選択で削除）。
こちらはSelect対象が1つより多いときにエラーとなってしまいますので
１つより多いときには処理を終了させるコードを記載してあげれば大丈夫です。
下記に追加してあります。

>エラー無く動くのですが、Cが既に入ってる上段行の下の行に入力すると（下記F4セルにCを入力すると）1行目にカット行が挿入されてしまいます。
こちらは入力されたセルの1つ上に文字が記入されていたら挿入をしない
ようなコードで平気でしょうか？

Private Sub Worksheet_Change(ByVal Target As Range)

　　With Target
　　　　If .Row < 4 Then Exit Sub
　　　　If .Column <> 10 Then Exit Sub
　　　　If .Count > 1 Then Exit Sub '追加
　　　　
　　　　Application.EnableEvents = False
　
　　　　If .Value = "c" Then
　　　　　　.Interior.ColorIndex = 44
　　　　'End If’削除
　
　　　　'If .Value = "c" Then’削除
　　　　　　If .Offset(-1).Value = "" Then '追加
　　　　　　　　.EntireRow.Cut
　　　　　　　　.End(xlUp).Offset(1).Activate
　　　　　　　　Rows(ActiveCell.Row).Insert Shift:=xlDown
　　　　　　End If '追加
　
　　　　End If

　　　　Application.EnableEvents = True

　　End With
　
End Sub


>なお上記コードで他にもエラーになりうる可能性がありますでしょうか？
あとはそうそうエラーにならないと思いますが、タケタケさんの希望動作を
完璧にしてくれるかどうかですね。

　　　A　　　　　　B　　　　　C　　　D　　　　 E　　　　F
1　 発注日　　　納入日　　　名称　　数量　　 単価　　 請求書C
2　01月15日　　01月20日　　バルブ　　1　　　 1500　　　 C（セル色がピンク）
3　01月19日　　01月22日　　リレー　　2　　　 5200　　　 C（セル色がピンク）
4　01月21日　　　　　　　　ねじ　　　2　　　　100
5　01月31日　　　　　　　　ワッシャ　5　　　　200　　　aaa
6　02月13日　　　　　　　　砥石　　　1　　　14800　

としたときに、F6に「C」を入力してもセルの色は変わりますがF4には
移動しませんね。
これでもよければ大丈夫なのですが。
もしくは、F列に「C」以外入力しないのでしたら問題ありません。
【59982】Re:行のカットと挿入について
お礼  タケタケ  - 09/1/22(木) 12:46 -
引用なし
パスワード
   ▼にぃ さん：

早速のご回答ありがとうございます。
うまく動きました。

下記質問あります。すいません初歩的ですが。。
1.
>>また、F列セルのDELETEするとエラーがでます（例えば、F2:F3セル選択で削除）。
>こちらはSelect対象が1つより多いときにエラーとなってしまいますので
>１つより多いときには処理を終了させるコードを記載してあげれば大丈夫です。
>下記に追加してあります。
If .Count > 1 Then Exit Sub '追加
このコードのことですか？
2.Application.EnableEvents = False　True　について
上記コードのことですが、色々調べましたが、まだ理解できずにいます。
わかりやすく教えて頂けないでしょうか？

なお、最後に、
このコードをファイル内の複数の同じ条件下のシートで使用しようと思っています。
ですが、対象のワークシートがたくさんあります。
各シートに同じコードを貼り付けていくのが面倒ですし、サイズも大きくなります。
一つのコードで、複数のワークシートを制御する簡単なやり方は無いでしょうか？
よろしくお願いします。
【59984】Re:行のカットと挿入について
発言  にぃ  - 09/1/22(木) 13:29 -
引用なし
パスワード
   ▼タケタケ さん：
こんにちは！

>1.
>>>また、F列セルのDELETEするとエラーがでます（例えば、F2:F3セル選択で削除）。
>>こちらはSelect対象が1つより多いときにエラーとなってしまいますので
>>１つより多いときには処理を終了させるコードを記載してあげれば大丈夫です。
>>下記に追加してあります。
>If .Count > 1 Then Exit Sub '追加
>このコードのことですか？
その通りです。

>2.Application.EnableEvents = False　True　について
>上記コードのことですが、色々調べましたが、まだ理解できずにいます。
>わかりやすく教えて頂けないでしょうか？
わかりやすく説明できるかわかりませんが、これはシートイベントのON,OFFを
するものです。
Application.EnableEvents = False　Trueを入れずに行ってみるとわかりますが、
行を挿入することで、またシートイベントが発生してしまうんですね。
そうするとまたこのシートイベントが発生し、
エラーになる原因になりますので、挿入作業のところで
シートイベントをOFFにする必要があります。

>なお、最後に、
>このコードをファイル内の複数の同じ条件下のシートで使用しようと思っています。
>ですが、対象のワークシートがたくさんあります。
>各シートに同じコードを貼り付けていくのが面倒ですし、サイズも大きくなります。
>一つのコードで、複数のワークシートを制御する簡単なやり方は無いでしょうか？
こちらはシートイベントではなくブックイベントに入れてあげればいいと思います。
そしてイベントを発生させたくないシートを除外してあげればいいと思います。

例
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
　　If Sh.Name = "Sheet1" Then Exit Sub
　　'処理
End Sub
【59986】Re:行のカットと挿入について
質問  タケタケ  - 09/1/22(木) 17:53 -
引用なし
パスワード
   ▼にぃ さん：

こんばんわ！ご返信ありがとうございます。
良くわかるご説明でようやく理解できました。

ブックイベントにて、ご教示頂いたコードを利用して、
作成しましたところ、正常に動作しました。

なお、もしあるシートだけが異なるコードが有る場合は、
どうすれば良いのでしょうか？

　　With Target
　　　　If .Row < 4 Then Exit Sub
　　　　If .Column <> 11 Then Exit Sub 　
　　　　↑あるシートだけがこのコードが異なる場合
　　　　If .Count > 1 Then Exit Sub

対象シートにコード作成すれば良いのでしょうか？

続いて質問あります。
次に、C入力してオレンジに変えたセルを、
Cを削除したらセルの色だけ元の戻したいと考えています。
下記コード作成しましたが、元にもどりません。

Private Sub Worksheet_Change(ByVal Target As Range)

　　With Target
　　　　If .Row < 4 Then Exit Sub
　　　　If .Column <> 10 Then Exit Sub
　　　　If .Count > 1 Then Exit Sub
　　
　　　　Application.EnableEvents = False

　　　　If .Value = "c" Then
　　　　　 .Interior.ColorIndex = 44

　　　　If .Offset(-1).Value = "" Then
　　　　　 .EntireRow.Cut
　　　　　 .End(xlUp).Offset(1).Activate
　　　　Rows(ActiveCell.Row).Insert Shift:=xlDown
　　　　
　　　　If .Value = .ClearContents Then　
　　　　　 .Interior.ColorIndex = 1
　　　　
　　　　End If
　　　　
　　　　End If

　　　　End If

　　　　Application.EnableEvents = True

　　End With

End Sub

↓このコードの使い方がおかしいのでしょうか？
　　　　If .Value = .ClearContents Then　
　　　　　 .Interior.ColorIndex = 1
　　　　　End If
【59987】Re:行のカットと挿入について
発言  ダースベーロー  - 09/1/22(木) 18:03 -
引用なし
パスワード
   ↓の方が「ご自分で」作成されたコードが参考になると思います。

ｈｔtp://security.okwave.jp/qa4650671.html?ans_count_asc=20
【60001】Re:行のカットと挿入について
発言  にぃ  - 09/1/23(金) 9:19 -
引用なし
パスワード
   ▼タケタケ さん：
こんにちは！


>なお、もしあるシートだけが異なるコードが有る場合は、
>どうすれば良いのでしょうか？
>対象シートにコード作成すれば良いのでしょうか？
そうですね。
ただし、If分岐などでブックイベントにそのシートだけ
ブックイベントを起こさないよう記述してください。
もしくはブックイベントにIf分岐などで、そのシートだけの
処理を記述してもいいと思います。


>次に、C入力してオレンジに変えたセルを、
>Cを削除したらセルの色だけ元の戻したいと考えています。
このようにすれば可能だと思います。

Private Sub Worksheet_Change(ByVal Target As Range)

　　With Target
　　　　If .Row < 4 Then Exit Sub
　　　　If .Column <> 10 Then Exit Sub
　　　　If .Count > 1 Then Exit Sub
　
　　　　Application.EnableEvents = False

　　　　If .Value = "c" Then
　　　　　　.Interior.ColorIndex = 44

　　　　　　If .Offset(-1).Value = "" Then
　　　　　　　　.EntireRow.Cut
　　　　　　　　.End(xlUp).Offset(1).Activate
　　　　　　　　Rows(ActiveCell.Row).Insert Shift:=xlDown
　　　　　　End If
　　　　　　
　　　　ElseIf .Value = Empty Then '追加
　　　　　　.Interior.ColorIndex = xlNone '追加
　　　　End If

　　　　Application.EnableEvents = True

　　End With

End Sub

>↓このコードの使い方がおかしいのでしょうか？
>　　　　If .Value = .ClearContents Then　
>　　　　　 .Interior.ColorIndex = 1
>　　　　　End If
.ClearContentsはセルを空白にする「動作」です。
ですので分岐条件では使用することが出来ません。
ここに入れるのでしたら「""」や「Empty」になります。
また、If .Value = "c" Thenの分岐の中に入れては動作してくれなくなります。


ちなみに、コードはなるべく同じ縦ラインに書かず、空白を入れてください。
そのほうが他の人が見るときにとても見やすくなります。
【60002】Re:行のカットと挿入について
お礼  タケタケ  - 09/1/23(金) 10:30 -
引用なし
パスワード
   ▼にぃ さん：
こんにちは！

>>なお、もしあるシートだけが異なるコードが有る場合は、
>>どうすれば良いのでしょうか？
>>対象シートにコード作成すれば良いのでしょうか？
>そうですね。
>ただし、If分岐などでブックイベントにそのシートだけ
>ブックイベントを起こさないよう記述してください。
>もしくはブックイベントにIf分岐などで、そのシートだけの
>処理を記述してもいいと思います。

ご指摘通りコード作成し、動作確認できました。


>>次に、C入力してオレンジに変えたセルを、
>>Cを削除したらセルの色だけ元の戻したいと考えています。
>このようにすれば可能だと思います。

>.ClearContentsはセルを空白にする「動作」です。
>ですので分岐条件では使用することが出来ません。
>ここに入れるのでしたら「""」や「Empty」になります。
>また、If .Value = "c" Thenの分岐の中に入れては動作してくれなくなります。

通常のエクセルのIF関数と同じように、
IF関数内にIFを入れることができるんですね。勉強になりました。

>>ちなみに、コードはなるべく同じ縦ラインに書かず、空白を入れてください。
>>そのほうが他の人が見るときにとても見やすくなります。

初心者で作成方法も知らず、コードを並べていましたが、
そう言われれば、第3者的にみると見にくいですね。

今後気をつけます。この度は、本当に勉強させて頂きました。
今後もよろしくお願いします。
【60003】Re:行のカットと挿入について
発言  にぃ  - 09/1/23(金) 10:38 -
引用なし
パスワード
   ▼タケタケ さん：
こんにちは！

ダースベーローさんのリンクを先ほど見ましたがマルチポストだったのですね。
解決後なのでとやかく言うことはしませんが、今後マルチポストはやめてください。
双方でしっかりと返事はしてくれているので、本当に回答がほしいだけだと
思いますが、回答者たちにはいい気持ちになりません。

また、回答がつかず他の掲示板に移動したい場合は、
その掲示板に「他の掲示板に移動します。」など記載してからにしてください。

それでは失礼しました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
3826 / 13645 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free