Excel VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
8754 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【31108】全シートでのﾙｰﾌﾟ処理 Duca 05/11/11(金) 17:00 質問[未読]
【31109】Re:全シートでのﾙｰﾌﾟ処理 Kein 05/11/11(金) 17:08 回答[未読]
【31112】Re:全シートでのﾙｰﾌﾟ処理 Duca 05/11/11(金) 17:40 発言[未読]
【31116】Re:全シートでのﾙｰﾌﾟ処理 Kein 05/11/11(金) 20:30 回答[未読]
【31174】Re:全シートでのﾙｰﾌﾟ処理 Duca 05/11/14(月) 9:50 質問[未読]
【31180】Re:全シートでのﾙｰﾌﾟ処理 Kein 05/11/14(月) 12:02 回答[未読]
【31195】Re:全シートでのﾙｰﾌﾟ処理 Duca 05/11/14(月) 14:18 質問[未読]
【31196】Re:全シートでのﾙｰﾌﾟ処理 Kein 05/11/14(月) 14:33 回答[未読]
【31202】Re:全シートでのﾙｰﾌﾟ処理 Duca 05/11/14(月) 14:56 お礼[未読]
【31333】Re:全シートでのﾙｰﾌﾟ処理 Duca 05/11/17(木) 18:38 質問[未読]
【31335】Re:全シートでのﾙｰﾌﾟ処理 Kein 05/11/17(木) 19:58 発言[未読]
【31339】Re:全シートでのﾙｰﾌﾟ処理 Duca 05/11/17(木) 21:37 発言[未読]
【31365】Re:全シートでのﾙｰﾌﾟ処理 Kein 05/11/18(金) 14:31 回答[未読]
【31367】Re:全シートでのﾙｰﾌﾟ処理 Duca 05/11/18(金) 14:44 質問[未読]
【31369】Re:全シートでのﾙｰﾌﾟ処理 Kein 05/11/18(金) 14:51 発言[未読]
【31371】Re:全シートでのﾙｰﾌﾟ処理 Duca 05/11/18(金) 15:08 発言[未読]
【31372】Re:全シートでのﾙｰﾌﾟ処理 Kein 05/11/18(金) 15:12 発言[未読]
【31374】Re:全シートでのﾙｰﾌﾟ処理 Duca 05/11/18(金) 15:17 発言[未読]
【31377】Re:全シートでのﾙｰﾌﾟ処理 Kein 05/11/18(金) 15:31 発言[未読]
【31380】Re:全シートでのﾙｰﾌﾟ処理 Duca 05/11/18(金) 15:43 発言[未読]
【31382】Re:全シートでのﾙｰﾌﾟ処理 Kein 05/11/18(金) 15:52 回答[未読]
【31386】Re:全シートでのﾙｰﾌﾟ処理 Duca 05/11/18(金) 16:12 発言[未読]
【31392】Re:全シートでのﾙｰﾌﾟ処理 Kein 05/11/18(金) 16:34 回答[未読]
【31395】Re:全シートでのﾙｰﾌﾟ処理 Duca 05/11/18(金) 16:58 発言[未読]
【31396】Re:全シートでのﾙｰﾌﾟ処理 Kein 05/11/18(金) 17:07 回答[未読]
【31401】Re:全シートでのﾙｰﾌﾟ処理 Duca 05/11/18(金) 17:56 発言[未読]
【31193】Re:全シートでのﾙｰﾌﾟ処理 Duca 05/11/14(月) 13:59 発言[未読]
【31200】Re:全シートでのﾙｰﾌﾟ処理 Duca 05/11/14(月) 14:49 発言[未読]
【31108】全シートでのﾙｰﾌﾟ処理
質問  Duca  - 05/11/11(金) 17:00 -
引用なし
パスワード
   お世話になります。

質問なんですが、
全てのSheetで指定した処理を行いたいと思っております。
しかし、ファイルは任意のファイルで行うために
Sheet名の指定はファイル毎に違うため出来ません。

こういった場合、
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿
Dim Flg As Boolean
　　Dim S　 As Worksheet

　　Flg = True
　　For Each S In Worksheets
　　　　S.Select (Flg)
　　　　Flg = False　　　　　　　
　　Next S
＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿＿

上記コードで全Sheetを指定すれば良いかと思い、
処理を挟んで試してみましたが途中にﾙｰﾌﾟ処理を入れたためか、
Sheet1では正常に処理をされていましたが
Sheet1以外のSheetではﾙｰﾌﾟ前にて処理が終わってしまっていました。

単一のSheetでは問題なく処理が行える為、
ﾙｰﾌﾟ処理がおかしいわけではないかと思っておりますが
なにが原因でこういうことになったのでしょうか？

また、他にいい処理の仕方があるようでしたら
そちらのご教授もお願い致します。

行いたい動作は、
"Sheet名がバラバラな任意のファイルの全Sheetにﾙｰﾌﾟを必要とする処理を行いたい"
ということです。

どうか、皆様よろしくお願いします。
【31109】Re:全シートでのﾙｰﾌﾟ処理
回答  Kein  - 05/11/11(金) 17:08 -
引用なし
パスワード
   >"Sheet名がバラバラな任意のファイルの全Sheetにﾙｰﾌﾟを必要とする処理を行いたい"
処理の内容は、どんなことでしょーか ? 普通は殆どの処理において、シートを
アクティブにしなくても出来るのです。だから

Dim S As Worksheet

For Each S In Worksheets
　S.Range("A1").Value = "A"
Next

などと、変数 S のプロパティやメソッドを直接操作するコードを書きます。

　
【31112】Re:全シートでのﾙｰﾌﾟ処理
発言  Duca  - 05/11/11(金) 17:40 -
引用なし
パスワード
   Keinさま
早速のお返事ありがとうございます。
以前にもお助け頂いて本当に感謝しております。

処理の内容はといいますと、

その1：ﾌｧｲﾙのE列の不確定な行にある"ｲﾍﾞﾝﾄA"を検出し(仮にE7とする)、
その下の行から"別ｲﾍﾞﾝﾄ"(仮にE10とする)まである空白行(E8〜E9)のD列(D8〜D9)の値をｸﾘｱし、
行(行8〜9)をｸﾞﾚｲに塗りつぶす。

その2："ｲﾍﾞﾝﾄA"(E7とする)のF列とG列(F7とG7)の値を"○○"と"○○○"と変える。

上記です。
これを全Sheetを対象にして処理を行いたいと思っております。
【31116】Re:全シートでのﾙｰﾌﾟ処理
回答  Kein  - 05/11/11(金) 20:30 -
引用なし
パスワード
   まんまのコードなら

Sub Test()
　 Dim Sh As Worksheet
　 Dim Ck1 As Variant, Ck2 As Variant

　 For Each Sh In Worksheets
　　　With Application
　　　　 Ck1 = .Match("ｲﾍﾞﾝﾄA", Sh.Range("E:E"), 0)
　　　　 Ck2 = .Match("別ｲﾍﾞﾝﾄ", Sh.Range("E:E"), 0)
　　　End With
　　　If Not IsError(Ck1) Then
　　　　 Sh.Cells(Ck1, 6).Reaize(, 2).Value = _
　　　　 Array("○○", "○○○")
　　　End If
　　　If Not IsError(Ck1) And Not IsError(Ck2) Then
　　　　 On Error Resume Next
　　　　 With Sh.Range(Sh.Cells(Ck1, 5), Sh.Cells(Ck2, 5)) _
　　　　 .SpecialCells(4)
　　　　　　.Offset(, 1).ClearContents
　　　　　　.EntireRow.Interior.ColorIndex = 16
　　　　 End With
　　　　 If Err.Number <> 0 Then Err.Clear
　　　　 On Error GoTo 0
　　　End If
　 Next
End Sub

てな感じになります。
【31174】Re:全シートでのﾙｰﾌﾟ処理
質問  Duca  - 05/11/14(月) 9:50 -
引用なし
パスワード
   Keinさま
いつもありがとうございます。
助かっております。

ご教授いただいたコードですが
ほぼ完璧な仕上がりになっておりました。
ありがとうございます。

ただ１つ質問なのですが
Ck2 = .Match("別ｲﾍﾞﾝﾄ", Sh.Range("E:E"), 0)
の、部分ですが
この箇所を"別ｲﾍﾞﾝﾄ"ではなく、
"ｲﾍﾞﾝﾄA"からﾗﾝﾀﾞﾑの行下にある、ﾗﾝﾀﾞﾑなｲﾍﾞﾝﾄ名に対応させるにはどのようにしたらよいのでしょうか？

詳しく説明させていただきますと、
ﾌｧｲﾙのﾗﾝﾀﾞﾑな位置にある"ｲﾍﾞﾝﾄA"から
次に出てくるﾗﾝﾀﾞﾑなｲﾍﾞﾝﾄ名までの範囲内で
処理を行いたいと思っております。

こういった範囲の指定をコードに表すとどうなりますでしょうか。
お手数をお掛けしますがどうかご教授お願いします。
【31180】Re:全シートでのﾙｰﾌﾟ処理
回答  Kein  - 05/11/14(月) 12:02 -
引用なし
パスワード
   >"ｲﾍﾞﾝﾄA"から次に出てくるﾗﾝﾀﾞﾑなｲﾍﾞﾝﾄ名までの範囲
ということは
「先にｲﾍﾞﾝﾄAを探し、必ずその下にあるｲﾍﾞﾝﾄ名を見つけて、そこまでの範囲」
という意味ですか ?　ならばこんな感じかな ?

Sub Test2()
　 Dim Sh As Worksheet
　 Dim Ck1 As Variant
　 Dim FR As Range

　 For Each Sh In Worksheets
　　　Ck1 = Application.Match("ｲﾍﾞﾝﾄA", Sh.Range("E:E"), 0)
　　　If IsError(Ck1) Then GoTo NLine
　　　Sh.Cells(Ck1, 6).Resize(, 2).Value = Array("○○", "○○○")
　　　 Set FR = Sh.Range("E:E") _
　　　.Find("別ｲﾍﾞﾝﾄ", Sh.Cells(Ck1, 5), xlValues)
　　　If Not FR Is Nothing Then
　　　　 On Error Resume Next
　　　　 With Sh.Range(Sh.Cells(Ck1, 5), FR).SpecialCells(4)
　　　　　　.Offset(, 1).ClearContents
　　　　　　.EntireRow.Interior.ColorIndex = 16
　　　　 End With
　　　　 If Err.Number <> 0 Then Err.Clear
　　　　 On Error GoTo 0: Set FR = Nothing
　　　End If
NLine:
　 Next
End Sub
【31193】Re:全シートでのﾙｰﾌﾟ処理
発言  Duca  - 05/11/14(月) 13:59 -
引用なし
パスワード
   自分で試行錯誤してみたところ、
下記コードにて思うような処理が行えましたが
もっとｽｯｷﾘとしたコードにならないものかと思っています。
　　
　　Flg = True
　　For Each Sh In Worksheets
　　　　Sh.Select (Flg)
　　　　Flg = False
　　　　
　　　　Columns("E").Select
　　　　Selection.Find(What:="ｲﾍﾞﾝﾄA", After:=ActiveCell, LookIn:=xlFormulas, _
　　　　　　LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
　　　　　　MatchCase:=False, MatchByte:=False, SearchFormat:=False).Activate
　　　　
　　　　If ActiveCell.Value <> "ｲﾍﾞﾝﾄA" Then
　　　　　　GoTo Exitsub
　　　　
　　　　ElseIf ActiveCell.Value = "ｲﾍﾞﾝﾄA" Then
　　　　　　J = ActiveCell.Address
　　　　　　Range(J).Offset(1, 0).Select
　　　　　　Row = ActiveCell.Row
　　　　
　　　　　　　　Do Until Range("E" & Row).Value <> ""
　　　　　　　　　　Range("D" & Row & ":AS" & Row).Interior.Color = RGB(192, 192, 192)
　　　　　　　　　　Range("D" & Row).Value = ""
　　
　　　　　　　　　　Row = Row + 1
　　　　　　　　 Loop
　　
　　　　　　　　lngRow = Range("F65536").End(xlUp).Row
　　　　　　　　　　If lngRow = 1 Then
　　　　　　　　　　　　If Range("F11").Value = "" Then
　　　　　　　　　　　　Exit Sub
　　　　　　　　　　　　Else
　　　　　　　　　　　　　　lngRow = 65536
　　　　　　　　　　　　 End If
　　　　　　　　　　End If
　　　　　　Application.ScreenUpdating = False
　　　　
　　　　　　For i = lngRow To 2 Step -1
　　　　　　　　If Range("E" & i).Value = "ｲﾍﾞﾝﾄA" Then
　　　　　　　　　　Range("F" & i).Value = "○○"
　　　　　　　　　　Range("G" & i).Value = "○○○"
　　　　　　　　End If
　　　　　　Next i
　　　　　　
　　　　End If
　　Next Sh
　　　　Application.ScreenUpdating = True

Exitsub:
End Sub

初心者な為、必要のない処理などを加えてるかもしれません。
必要のない箇所がございましたらご教授をお願いします。
【31195】Re:全シートでのﾙｰﾌﾟ処理
質問  Duca  - 05/11/14(月) 14:18 -
引用なし
パスワード
   Keinさま、いつもありがとうございます。
私の説明が下手なせいでご迷惑をお掛けします。
先ほど、新たな質問を返信させていただいたのですが
もっとｽｯｷﾘしたコードが組めないものかと思っています。


説明下手ですので詳しく長々と書かせていただきます。

ﾌｧｲﾙのE列のどこかに"ｲﾍﾞﾝﾄA"があります。
そして、E列"ｲﾍﾞﾝﾄA"の下にはいくつか空白行があり、
その空白行の数はﾌｧｲﾙによって違うため定まっておりません。
そして、空白行が続いたあとには"ｲﾍﾞﾝﾄA"とは別のｲﾍﾞﾝﾄがあるのですが
このｲﾍﾞﾝﾄ名はﾌｧｲﾙによって違ってきます(ｲﾍﾞﾝﾄBのときもあればCのときもある)

　 D　　E　　　F　　　G　　　
1　a　ｲﾍﾞﾝﾄA
2　b
3　c
4　d
5　e　ｲﾍﾞﾝﾄB

このﾌｧｲﾙの"ｲﾍﾞﾝﾄA"の下からﾌｧｲﾙによって名前が違う"ｲﾍﾞﾝﾄA"の次のｲﾍﾞﾝﾄまでのD2からD4の値をｸﾘｱし、行2から行4までを塗りつぶし、
また、"ｲﾍﾞﾝﾄA"の行にあるF列とG列(表でいうとF1とG1)にそれぞれ○○と○○○を
書き込みたいと考えております。


何度もお手を煩わせて申し訳ありませんが
今一度、お力添えをお願いします。
【31196】Re:全シートでのﾙｰﾌﾟ処理
回答  Kein  - 05/11/14(月) 14:33 -
引用なし
パスワード
   では、こーいうことですか ?

Sub Test3()
　 Dim Sh As Worksheet
　 Dim Ck1 As Variant
　 Dim FR As Range

　 For Each Sh In Worksheets
　　　Ck1 = Application.Match("ｲﾍﾞﾝﾄA", Sh.Range("E:E"), 0)
　　　If IsError(Ck1) Then GoTo NLine
　　　Sh.Cells(Ck1, 6).Resize(, 2).Value = Array("○○", "○○○")
　　　 Set FR = Sh.Range("E:E") _
　　　.Find("ｲﾍﾞﾝﾄ*", Sh.Cells(Ck1, 5), xlValues, xlPart)
　　　If Not FR Is Nothing Then
　　　　 On Error Resume Next
　　　　 With Sh.Range(Sh.Cells(Ck1 + 1, 5), FR.Offset(-1)).SpecialCells(4)
　　　　　　.Offset(, -1).ClearContents
　　　　　　.EntireRow.Interior.ColorIndex = 16
　　　　 End With
　　　　 If Err.Number <> 0 Then Err.Clear
　　　　 On Error GoTo 0: Set FR = Nothing
　　　End If
NLine:
　 Next
End Sub
【31200】Re:全シートでのﾙｰﾌﾟ処理
発言  Duca  - 05/11/14(月) 14:49 -
引用なし
パスワード
   申し訳ございません。
あと1つ忘れていました。

先ほど私が挙げたコードですが
実際のﾌｧｲﾙでは
Sheet1は目次のページとなっていて実際の表はSheet2からとなっているﾌｧｲﾙと
Sheet1から指定の表になっているものとあります。

両者に対応するにはどのようにしたら良いのか悩んでおります。
目次があるﾌｧｲﾙでは処理が途中で止まるようにしてしまっているのか(自分で作りながら理解出来ていないです・・)
Sheet2以降の処理が行われません。

どうか、合わせてご教授をお願いいたします。
【31202】Re:全シートでのﾙｰﾌﾟ処理
お礼  Duca  - 05/11/14(月) 14:56 -
引用なし
パスワード
   おお・・・。
これはもう完璧です。
素晴らしい出来栄えでした。

目次がが〜・・・という問題もこれでしたら
問題なく処理が出来ますね。

本当に助かります。
本当に素晴らしい出来でした。感謝しております。

本当にいつもいつもありがとうございます。
Keinさんがご教授くださったものを自分の力に変えていきたいと思います。

ありがとうございました！
【31333】Re:全シートでのﾙｰﾌﾟ処理
質問  Duca  - 05/11/17(木) 18:38 -
引用なし
パスワード
   Kein様

解決した質問に再度、質問を載せて申し訳ありませんが
またお助けいただき投稿させてもらいました。


本件でお教え頂いたコードのことで質問がございます。

覚えてらっしゃるかわかりませんが
"ｲﾍﾞﾝﾄA"をﾌｧｲﾙから見つけ〜・・・
という処理でしたが

1つのﾌｧｲﾙ内に"ｲﾍﾞﾝﾄA"がいくつかある可能性もあり、
他の箇所の"ｲﾍﾞﾝﾄA"毎にも同様の処理を行うにはどのようしたらよいのでしょうか。

誠に申し訳ございませんが
どうかよろしくお願いたします。
【31335】Re:全シートでのﾙｰﾌﾟ処理
発言  Kein  - 05/11/17(木) 19:58 -
引用なし
パスワード
   >1つのﾌｧｲﾙ内に"ｲﾍﾞﾝﾄA"がいくつかある
は分かりますが、それは必ずその下に ｲﾍﾞﾝﾄB とか ｲﾍﾞﾝﾄC などが"対"になって
存在するのですか ? つまり

　　A　 B　 C　 D　 E
1
2　　　　　　　　 ｲﾍﾞﾝﾄA
3
4
5　　　　　　　　 ｲﾍﾞﾝﾄC
6
7　　　　　　　　 ｲﾍﾞﾝﾄA
8
9　　　　　　　　 ｲﾍﾞﾝﾄB

というようになっているのかどうかです。全てのシートで。
【31339】Re:全シートでのﾙｰﾌﾟ処理
発言  Duca  - 05/11/17(木) 21:37 -
引用なし
パスワード
   Keinさま
返信ありがとうございます。

ｲﾍﾞﾝﾄAの次のｲﾍﾞﾝﾄですが
BのときもあればCのときもDのときもありますので
不特定であります。
また、ｲﾍﾞﾝﾄAが最後のｲﾍﾞﾝﾄである可能性も少なからずありますが
基本的には次のｲﾍﾞﾝﾄはあります。
出来れば最後のｲﾍﾞﾝﾄでも対応出来るといいのですが
難しいようでしたら次のｲﾍﾞﾝﾄがあることを前提でもいいですので
ご教授をお願いしたい次第です。

Bookの作りですが
Sheet1に目次がありSheet2から表があるファイルもあれば目次がないファイルもあり、
それらに対応したものが必要です。
【31365】Re:全シートでのﾙｰﾌﾟ処理
回答  Kein  - 05/11/18(金) 14:31 -
引用なし
パスワード
   まず
>Sheet1に目次がありSheet2から表がある
ということなら、その見分け方を書いてもらいたかったのですが、いちおう
「先頭シートのE列に "ｲﾍﾞﾝﾄA" が見つからない場合は目次、そうでなければ
表のあるデータ」とみなすことにして

Sub Test_X()
　 Dim Ck As Variant
　 Dim Sti As Long, Mi As Long
　 Dim i As Long, j As Long
　 Dim TgR As Range, MyR1 As Range
　 Dim MyR2 As Range, MyR3 As Range
　
　 Ck = Application.Match("ｲﾍﾞﾝﾄA", Worksheets(1).Range("E:E"), 0)
　 If IsError(Ck) Then
　　　Sti = 2
　 Else
　　　Sti = 1
　 End If
　 For j = Sti To Worksheets.Count
　　　Set TgR = _
　　　Sheets(j).Range("E2", Sheets(j).Range("E65536").End(xlUp)) _
　　　.Offset(, 26)
　　　TgR.Formula = _
　　　"=IF(LEFT($E2,5)=""ｲﾍﾞﾝﾄ"",IF(RIGHT($E2,1)=""A"",FALSE,#N/A),"""")"
　　　On Error GoTo NLine
　　　Set MyR1 = TgR.SpecialCells(3, 4)
　　　Set MyR2 = TgR.SpecialCells(3, 16)
　　　On Error GoTo 0
　　　Mi = Application.Min(MyR1.Count, MyR2.Count)
　　　For i = 1 To Mi
　　　　 MyR1.Areas(i).Offset(, -25).Resize(, 2).Value = _
　　　　 Array("○○", "○○○")
　　　　 Set MyR3 = Range(MyR1.Areas(i), MyR2.Areas(i)).Offset(, -26)
　　　　 If WorksheetFunction.CountBlank(MyR3) > 0 Then
　　　　　　With MyR3.SpecialCells(4)
　　　　　　　 .Offset(, -1).ClearContents
　　　　　　　 .EntireRow.Interior.ColorIndex = 16
　　　　　　End With
　　　　 End If
　　　　 Set MyR3 = Nothing
　　　Next i
NLine:
　　　TgR.ClearContents
　　　Set TgR = Nothing: Set MyR1 = Nothing: Set MyR2 = Nothing
　　　If Err.Number <> 0 Then Err.Clear
　 Next j
End Sub
【31367】Re:全シートでのﾙｰﾌﾟ処理
質問  Duca  - 05/11/18(金) 14:44 -
引用なし
パスワード
   Kein様

お待ちしていました。ありがとうございます。
期限が本日の18時ころまでとなっているので焦っておりました。


大変、申し訳ございません。
目次のSheetにはｲﾍﾞﾝﾄAという言葉はないので
ｲﾍﾞﾝﾄAがなかったら、ということでよろしいかと思います。
ですが、今まで散々ｲﾍﾞﾝﾄAやｲﾍﾞﾝﾄBなどいっておりましたが
実際の表では"ｲﾍﾞﾝﾄ"という言葉はついておらず、
ただのAなどという言葉だけだったりして
それぞれのｲﾍﾞﾝﾄ項目に共通する言葉は実際になかったりします・・・。


>"=IF(LEFT($E2,5)=""ｲﾍﾞﾝﾄ"",IF(RIGHT($E2,1)=""A"",FALSE,#N/A),"""")"

この部分の問題か処理が行われずに終わってしまいました。
説明不足といいますか、なんというか煩わしいことをさせて申し訳ありません。

上記を踏まえた場合、どのように修正したらよろしいでしょうか？
【31369】Re:全シートでのﾙｰﾌﾟ処理
発言  Kein  - 05/11/18(金) 14:51 -
引用なし
パスワード
   >ただのAなどという言葉
これだけでは、まだ説明不足ですね・・。
実際に E列にはどんな文字が入力されているか、具体的な例をできるだけ書き出して
みて下さい。そしてその中でどの語句を目標とすればいいか、はっきり示して下さい。
あなたの方で応用が効かないなら、そうするしかありませんから。
【31371】Re:全シートでのﾙｰﾌﾟ処理
発言  Duca  - 05/11/18(金) 15:08 -
引用なし
パスワード
   Keinさま
ご返信ありがとうございます。

具体的にいいますと、
"開閉確認"　"動作確認"　"その他のﾎﾞﾀﾝ"
などという言葉があり、
その中の"画面遷移直後"という言葉が目標になっております。

私の知識が乏しいばかりにご迷惑をお掛けします。
【31372】Re:全シートでのﾙｰﾌﾟ処理
発言  Kein  - 05/11/18(金) 15:12 -
引用なし
パスワード
   そーするとですよ。"画面遷移直後"という語句だけでは、それが当初から言われていた
"ｲﾍﾞﾝﾄA" に相当するのか、それとも"ｲﾍﾞﾝﾄB" や C に相当するのか ? という疑問が
出てきますがどうなんでしょーか ? こちらの立場になって考えて、レスをお願いします。
【31374】Re:全シートでのﾙｰﾌﾟ処理
発言  Duca  - 05/11/18(金) 15:17 -
引用なし
パスワード
   申し訳ございません。

ｲﾍﾞﾝﾄAと言っていたものが"画面遷移直後"で
他のｲﾍﾞﾝﾄBやCは"画面遷移直後"とは別の項目ということです。

ご迷惑をお掛けします。
【31377】Re:全シートでのﾙｰﾌﾟ処理
発言  Kein  - 05/11/18(金) 15:31 -
引用なし
パスワード
   弱ったね・・まったく・・。
>"画面遷移直後"とは別の項目
だったらそれを具体的に書かないとダメでしょ。先にも書いたように
「こちらの立場に立って書いて欲しい」のです。
こちらにはあなたのPCの画面が、全く見えていないのが分かりますか ?
だから全ての情報を事細かく説明されないと、仕事ができない状態
なんですよ !
【31380】Re:全シートでのﾙｰﾌﾟ処理
発言  Duca  - 05/11/18(金) 15:43 -
引用なし
パスワード
   失礼しました。

E列には主に
開閉確認
動作確認
その他のﾎﾞﾀﾝ
ﾃﾝｷｰ
表示確認
があり、ﾌｧｲﾙによってはない項目もあります。
ﾌｧｲﾙの数は無数にあるため、どれが大体なくどれは大体あるか、なども言い切れません。
無数にあるため、上記以外のものもある場合もございます。

また"画面遷移直後"の行数も次のｲﾍﾞﾝﾄも不特定であります。

ですので
ｲﾍﾞﾝﾄBやｲﾍﾞﾝﾄCと言っていた項目は"画面遷移直後"以外の不特定の項目となっております。
それが定まっていないようでしたら今回の処理は難しいでしょうか。
【31382】Re:全シートでのﾙｰﾌﾟ処理
回答  Kein  - 05/11/18(金) 15:52 -
引用なし
パスワード
   >"画面遷移直後"以外の不特定の項目
つまり"画面遷移直後"以外の入力値は、全て "ｲﾍﾞﾝﾄ某" に当たると考えて
良いのですね ? ならば数式の部分を

TgR.Formula = _
"=IF($E2=""画面遷移直後"",FALSE,IF($E2<>"""",#N/A,""""))"

と変更して、やってみて下さい。
【31386】Re:全シートでのﾙｰﾌﾟ処理
発言  Duca  - 05/11/18(金) 16:12 -
引用なし
パスワード
   Keinさまの立場になってでの説明でなく大変にご迷惑をお掛けしました。

上記に置き換えてやってみたところの行った処理は、

　A　B　C　D　E　　　　　　 F　 G
12　　　　　　画面遷移直後　○　○○
13
14
15
16
17
18
19
20
21　　　　　　ﾃﾝｷｰ
-------------------------------------------------
22　ここからグレー


上記処理となっており、
行23以降はE列に何かしらの項目が入ってる行だけ塗り潰しなしで
あとの空白は全て塗り潰し(+D列クリア)となっておりました。

私の説明に問題であったかもしれません。
行いたい処理は、
"画面遷移直後"の下の行(表でいうと行13)から"ﾃﾝｷｰ"(不特定項目)の1つ上までの行(行20)を
グレーに塗り潰しし、D列クリアを、
いくつかある、"画面遷移直後"の下の行(不特定)からｲﾍﾞﾝﾄ某(不特定項目)の1つ上までの行(不特定)毎に行うということです。(全シートに)

すみませんでした。
【31392】Re:全シートでのﾙｰﾌﾟ処理
回答  Kein  - 05/11/18(金) 16:34 -
引用なし
パスワード
   こちらでテストしてみましたが

>"画面遷移直後"の下の行(表でいうと行13)から"ﾃﾝｷｰ"(不特定項目)の1つ上までの行
>(行20)をグレーに塗り潰しし、D列クリアを、いくつかある、"画面遷移直後"の下の
>行(不特定)からｲﾍﾞﾝﾄ某(不特定項目)の1つ上までの行(不特定)毎に行う

は、完全に出来てましたが。強いて言うと冒頭のところも直さないといけないので

Sub Test_X2()
　 Dim Ck As Variant
　 Dim Sti As Long, Mi As Long
　 Dim i As Long, j As Long
　 Dim TgR As Range, MyR1 As Range
　 Dim MyR2 As Range, MyR3 As Range
　
　 Ck = Application.Match("画面遷移直後", Worksheets(1).Range("E:E"), 0)
　 If IsError(Ck) Then
　　　Sti = 2
　 Else
　　　Sti = 1
　 End If
　 For j = Sti To Worksheets.Count
　　　Set TgR = _
　　　Sheets(j).Range("E2", Sheets(j).Range("E65536").End(xlUp)) _
　　　.Offset(, 26)
　　　TgR.Formula = _
　　　"=IF($E2=""画面遷移直後"",FALSE,IF($E2<>"""",#N/A,""""))"
　　　On Error GoTo NLine
　　　Set MyR1 = TgR.SpecialCells(3, 4)
　　　Set MyR2 = TgR.SpecialCells(3, 16)
　　　On Error GoTo 0
　　　Mi = Application.Min(MyR1.Count, MyR2.Count)
　　　For i = 1 To Mi
　　　　 MyR1.Areas(i).Offset(, -25).Resize(, 2).Value = _
　　　　 Array("○○", "○○○")
　　　　 Set MyR3 = _
　　　　 Range(MyR1.Areas(i).Offset(1), MyR2.Areas(i).Offset(-1)) _
　　　　 .Offset(, -26)
　　　　 If WorksheetFunction.CountBlank(MyR3) > 0 Then
　　　　　　With MyR3.SpecialCells(4)
　　　　　　　 .Offset(, -1).ClearContents
　　　　　　　 .EntireRow.Interior.ColorIndex = 16
　　　　　　End With
　　　　 End If
　　　　 Set MyR3 = Nothing
　　　Next i
NLine:
　　　TgR.ClearContents
　　　Set TgR = Nothing: Set MyR1 = Nothing: Set MyR2 = Nothing
　　　If Err.Number <> 0 Then Err.Clear
　 Next j
End Sub

と、しなくてはいけなかったですが。
【31395】Re:全シートでのﾙｰﾌﾟ処理
発言  Duca  - 05/11/18(金) 16:58 -
引用なし
パスワード
   う〜ん。。なぜでしょうか。
他の、例えば"その他のﾎﾞﾀﾝ"から"開閉など"の間の空白行も塗り潰され、D列クリアされてしまっています。

私の説明不足が原因なんでしょうね。
どういう処理を行っているのかわからないので
どう説明したらいいのか見当がつきません。。


今までは全シート対象＋Sheet1に目次が入る可能性がある場合の
コードをご教授いただきましたが
仮にそれを除外し、
1Sheetのみで
>"画面遷移直後"の下の行(表でいうと行13)から"ﾃﾝｷｰ"(不特定項目)の1つ上までの行
>(行20)をグレーに塗り潰しし、D列クリアを、いくつかある、"画面遷移直後"の下の
>行(不特定)からｲﾍﾞﾝﾄ某(不特定項目)の1つ上までの行(不特定)毎に行う

という処理をする場合はどういった具合になるのでしょうか。
【31396】Re:全シートでのﾙｰﾌﾟ処理
回答  Kein  - 05/11/18(金) 17:07 -
引用なし
パスワード
   ならば「アクティブシートのみの処理」ということにして

　 Sub Test_X3()
　　　Dim Mi As Long, i As Long
　　　Dim TgR As Range, MyR1 As Range
　　　Dim MyR2 As Range, MyR3 As Range
　
　　　Set TgR = _
　　　Range("E2", Range("E65536").End(xlUp)).Offset(, 26)
　　　TgR.Formula = _
　　　"=IF($E2=""画面遷移直後"",FALSE,IF($E2<>"""",#N/A,""""))"
　　　On Error GoTo NLine
　　　Set MyR1 = TgR.SpecialCells(3, 4)
　　　Set MyR2 = TgR.SpecialCells(3, 16)
　　　On Error GoTo 0
　　　Mi = Application.Min(MyR1.Count, MyR2.Count)
　　　For i = 1 To Mi
　　　　 MyR1.Areas(i).Offset(, -25).Resize(, 2).Value = _
　　　　 Array("○○", "○○○")
　　　　 Set MyR3 = _
　　　　 Range(MyR1.Areas(i).Offset(1), MyR2.Areas(i).Offset(-1)) _
　　　　 .Offset(, -26)
　　　　 If WorksheetFunction.CountBlank(MyR3) > 0 Then
　　　　　　With MyR3.SpecialCells(4)
　　　　　　　 .Offset(, -1).ClearContents
　　　　　　　 .EntireRow.Interior.ColorIndex = 16
　　　　　　End With
　　　　 End If
　　　　Set MyR3 = Nothing
　　 Next i
　NLine:
　　 TgR.ClearContents
　　 Set TgR = Nothing: Set MyR1 = Nothing: Set MyR2 = Nothing
　End Sub

てな感じです。
【31401】Re:全シートでのﾙｰﾌﾟ処理
発言  Duca  - 05/11/18(金) 17:56 -
引用なし
パスワード
   なぜなのか、余分な行までグレーになってしまうのが
直りません。。

少し自分でやってみます。
お手数をお掛けしました。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
8754 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free