Excel VBA質問箱 IV

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

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


1488 / 13646 ツリー ←次へ | 前へ→

【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があれば同じ行のKからAQ(L列も含む)を削除するコードご教授ください。
ランダムに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の&#10003;もコードでセルをダブルクリックしたら&#10003;が入るように設定しています。
関係ありますか?&#10003;のコードは下記です。

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"があればの条件を
2つにしたい場合、どのようにすれば良いでしょうか?
L列に"Before opereation" M列が空白の場合(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 さん:

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

1488 / 13646 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free