Excel VBA質問箱 IV

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

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


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

1507 / 13665 ﾂﾘｰ

←次へ　｜　前へ→

▼

【74085】セルにある値があれば削除 nonoka 13/4/17(水) 18:33

【74089】Re:セルにある値があれば削除 カエムワセト 13/4/17(水) 20:04

【74091】Re:セルにある値があれば削除 nonoka 13/4/17(水) 20:16

【74094】Re:セルにある値があれば削除 UO3 13/4/17(水) 21:08

【74105】Re:セルにある値があれば削除 nonoka 13/4/18(木) 9:29

【74106】Re:セルにある値があれば削除 nonoka 13/4/18(木) 9:52

【74108】Re:セルにある値があれば削除 nonoka 13/4/18(木) 14:06

【74109】Re:セルにある値があれば削除 UO3 13/4/18(木) 14:22

【74110】Re:セルにある値があれば削除 nonoka 13/4/18(木) 14:32

【74111】Re:セルにある値があれば削除 UO3 13/4/18(木) 15:52

【74112】Re:セルにある値があれば削除 UO3 13/4/18(木) 16:04

【74113】Re:セルにある値があれば削除 nonoka 13/4/18(木) 17:27


	【74085】セルにある値があれば削除

nonoka - 13/4/17(水) 18:33 -


	引用なし

	パスワード

いつもお世話になっております。

シート名"INPUT"のB5に✓が入っているのがコード実行条件で

シート名"Schedule"のAからAQの範囲（下は無限）に表があります。
L列にBefore opereationがあれば同じ行のＫからＡＱ（Ｌ列も含む）を削除するコードご教授ください。
ランダムにBefore opereationは存在します。

宜しくお願い申し上げます！！


	【74089】Re:セルにある値があれば削除

カエムワセト - 13/4/17(水) 20:04 -


	引用なし

	パスワード

>下は無限

新種のエクセルかな？
無限の行数があるエクセルというのは初耳です。

>削除

セルのクリアなのかな？
あるいはセルを削除して詰めるのかな？
削除して詰めるのならどちらに詰めるのか？

クリアなら、Findメソッドなどで検索して見つかったセルを
クリア、でいけますが、削除して詰めるのならちょいと一工夫
必要かも。

上から削除していくと削除することによりセル番地がずれる
可能性があります。

一旦クリアして空白行にジャンプしてセルを詰める、という
ことになるかな。


	【74091】Re:セルにある値があれば削除

nonoka - 13/4/17(水) 20:16 -


	引用なし

	パスワード

▼カエムワセトさん：
よろしくお願いします。

>無限の行数があるエクセルというのは初耳です。
そうですね。無限という表現は間違いでした。
積み上げ式の表になります。
>>削除
>セルのクリアなのかな？
単なるクリアです。
セルを選択して、ディレートキーを押すイメージです。
詰める必要はありません。
よろしくお願いします。


	【74094】Re:セルにある値があれば削除

UO3 - 13/4/17(水) 21:08 -


	引用なし

	パスワード

▼nonoka さん：

こんな感じですか？

Sub Sample()
　　Dim c As Range
　　
　　If Sheets("INPUT").Range("B5").Value <> "&#10003" Then Exit Sub
　　
　　Application.ScreenUpdating = False
　　
　　With Sheets("Schedule")
　　
　　　　Set c = .Columns("L").Find(What:="Before opereation", LookAt:=xlWhole)
　　　　
　　　　Do While Not c Is Nothing
　　　　　　c.EntireRow.Range("K1:AQ1").ClearContents
　　　　　　Set c = .Columns("L").FindNext(After:=c)
　　　　Loop
　 End With
　　
　 Application.ScreenUpdating = True
　
End Sub


	【74105】Re:セルにある値があれば削除

nonoka - 13/4/18(木) 9:29 -


	引用なし

	パスワード

▼UO3 さん：
いつもありがとうございます。
下記の★の付いた行を削除すればうまく作動するのですが・・・。
B5の✓もコードでセルをダブルクリックしたら✓が入るように設定しています。
関係ありますか？✓のコードは下記です。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　　If Intersect(Target, Range("B5")) Is Nothing = False Then
　　Cancel = True
　　　　If Target.Value = ChrW(10003) Then
　　　　Target.ClearContents
　　　　　　Else
　　　　　　Target.Value = ChrW(10003)
　　　　End If
　　End If
End Sub

>Sub Sample()
>　　Dim c As Range
>　　
>　★　If Sheets("INPUT").Range("B5").Value <> "&#10003" Then Exit Sub
>　　
>　★　Application.ScreenUpdating = False
>　　
>　　With Sheets("Schedule")
>　　
>　　　　Set c = .Columns("L").Find(What:="Before opereation", LookAt:=xlWhole)
>　　　　
>　　　　Do While Not c Is Nothing
>　　　　　　c.EntireRow.Range("K1:AQ1").ClearContents
>　　　　　　Set c = .Columns("L").FindNext(After:=c)
>　　　　Loop
>　 End With
>　　
>　 Application.ScreenUpdating = True
>　
>End Sub


	【74106】Re:セルにある値があれば削除

nonoka - 13/4/18(木) 9:52 -


	引用なし

	パスワード

▼UO3 さん：
わかりました。
operationのスペルが違っていました。
お騒がせしました。
無事完了です。
ありがとうございました！！


	【74108】Re:セルにある値があれば削除

nonoka - 13/4/18(木) 14:06 -


	引用なし

	パスワード

▼UO3 さん：

一つ質問です。
下記コードで
Set c = .Columns("L").Find(What:="Before opereation", LookAt:=xlWhole)
の部分、L列に"Before opereation"があればの条件を
２つにしたい場合、どのようにすれば良いでしょうか？
Ｌ列に"Before opereation"　Ｍ列が空白の場合（2条件一致）
としたいです。
宜しくお願いします。

>
>Sub Sample()
>　　Dim c As Range
>　　
>　　If Sheets("INPUT").Range("B5").Value <> "&#10003" Then Exit Sub
>　　
>　　Application.ScreenUpdating = False
>　　
>　　With Sheets("Schedule")
>　　
>　　　　Set c = .Columns("L").Find(What:="Before opereation", LookAt:=xlWhole)
>　　　　
>　　　　Do While Not c Is Nothing
>　　　　　　c.EntireRow.Range("K1:AQ1").ClearContents
>　　　　　　Set c = .Columns("L").FindNext(After:=c)
>　　　　Loop
>　 End With
>　　
>　 Application.ScreenUpdating = True
>　
>End Sub


	【74109】Re:セルにある値があれば削除

UO3 - 13/4/18(木) 14:22 -


	引用なし

	パスワード

▼nonoka さん：

こんにちは。
M列が空白の場合にのみ処理するコードを追加しました。
また、
If Sheets("INPUT").Range("B5").Value <> "&#10003" Then Exit Sub
としていましたが、ほんとうが、値はレ点ですね。
そこも変更してあります。

ところで、現在、シートイベントでレ点セットしておられますよね。
今回のコード、もしかしたら、そのイベントルーティンに組み込むほうがいいのでは？

Sub Sample2()
　　Dim c As Range
　
　　If Sheets("INPUT").Range("B5").Value <> ChrW(10003) Then Exit Sub
　
　　Application.ScreenUpdating = False
　
　　With Sheets("Schedule")
　
　　　　Set c = .Columns("L").Find(What:="Before opereation", LookAt:=xlWhole)
　　
　　　　Do While Not c Is Nothing
　　　　　　If Len(c.Offset(, 1).Value) = 0 Then 'M列が空白なら
　　　　　　　　c.EntireRow.Range("K1:AQ1").ClearContents
　　　　　　End If
　　　　　　Set c = .Columns("L").FindNext(After:=c)
　　　　Loop
　 End With
　
　 Application.ScreenUpdating = True
　
End Sub


	【74110】Re:セルにある値があれば削除

nonoka - 13/4/18(木) 14:32 -


	引用なし

	パスワード

▼UO3 さん：
今回のｺｰﾄﾞはcallで別コードに組み込んでいます。

一つ質問です。
”M列が空白なら”の条件ですが、最下段までループが抜けないように思いますが。実際抜けません。
L列が"Before operation"でかつM列が空白というコードですか？


	【74111】Re:セルにある値があれば削除

UO3 - 13/4/18(木) 15:52 -


	引用なし

	パスワード

▼nonoka さん：

>”M列が空白なら”の条件ですが、最下段までループが抜けないように思いますが。実際抜けません。
>L列が"Before operation"でかつM列が空白というコードですか？

ごめんなさい。
空白は除外したということは、その行については　Before operation　が存在するということでしたね。
うっかりしていました。一回りしたら終わりにしなければいけませんね。

後程、コードをアップします。
しばしお待ちください。


	【74112】Re:セルにある値があれば削除

UO3 - 13/4/18(木) 16:04 -


	引用なし

	パスワード

▼nonoka さん：

改訂版です。

Sub Sample2()
　　Dim c As Range
　　Dim f As Range
　　
　　If Sheets("INPUT").Range("B5").Value <> ChrW(10003) Then Exit Sub

　　Application.ScreenUpdating = False

　　With Sheets("Schedule")

　　　　Set c = .Columns("L").Find(What:="Before operation", LookAt:=xlWhole)
　　　　If c Is Nothing Then Exit Sub
　　　　Set f = c
　　　　Do
　　　　　　If Len(c.Offset(, 1).Value) = 0 Then 'M列が空白なら
　　　　　　　　c.EntireRow.Range("K1:AQ1").ClearContents
　　　　　　End If
　　　　　　Set c = .Columns("L").FindNext(After:=c)
　　　　　　
　　　　　　If c Is Nothing Then Exit Do
　　　　　　If c.Address = f.Address Then Exit Do
　　　　Loop
　 End With

　 Application.ScreenUpdating = True

End Sub


	【74113】Re:セルにある値があれば削除

nonoka - 13/4/18(木) 17:27 -


	引用なし

	パスワード

▼UO3 さん：

改良版でＯＫでした！
ありがとうございました！
また、新トピでお世話になると思いますが宜しくお願い致します。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

1507 / 13665 ﾂﾘｰ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free