[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『処理スピードがおそいのです』（正明）
Sub 在庫あり〇()
Dim cl As Integer
Dim cell As Range
Dim a As Integer
cl = ActiveCell.Column
Select Case cl
Case 9 To 14
Union(Range("I8:N50"), Range("I60:N99"), Range("I109:N137")).Select
Case 24 To 29
Union(Range("X8:AC50"), Range("X60:AC99"), Range("X109:AC137")).Select
Case 39 To 44
Union(Range("AM8:AR50"), Range("AM60:AR99"), Range("AM109:AR137")).Select
Case 54 To 59
Union(Range("BB8:BG50"), Range("BB60:BG99"), Range("BB109:BG137")).Select
Case 69 To 74
Union(Range("BQ8:BV50"), Range("BQ60:BV99"), Range("BQ109:BV137")).Select
End Select
For Each cell In Selection
If cell.Value = "" And cell.Interior.Color <> RGB(255, 183, 192) Then
cell.Value = "在庫あり〇"
End If
Next
ActiveCell.Select
End Sub
どのようにコードを書きかえればいいのでしょうか？
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
■２
処理に時間がかかるということですが、【ステップ実行】してどこでどのような処理をしているか検証してみてはどうでしょうか？
（尤も、今回のケースではちょっとわかりづらいかもしれませんが。。。）
■３
今回のケースで時間がかかるのは↓の部分です。
For Each cell In Selection
If cell.Value = "" And cell.Interior.Color <> RGB(255, 183, 192) Then
cell.Value = "在庫あり〇"
End If
Next
要は、選択したセル範囲の中から１セルずつ取り出して、判定の結果、条件を満たしていたらセルに書き込みを行っているわけですが、この【セルへの書き込み】を逐一行っているために時間がかかっています。
条件を満たしたセルはいずれも"在庫あり〇"と書き込めばよいのですから、逐一書き込まずに、いっぺんに書き込むことを考えるとよいです。
したがって、たとえば↓のようにする方法で高速化が望めると思います。
(そのほかも直しました。（ただの好みによる部分なので説明は省きます)）
Sub 在庫あり〇_改()
Dim 行範囲 As Range
Dim 列範囲 As Range
Dim tmpRNG As Range, MyRNG As Range
Stop 'ブレークポイントの代わり
'▼行範囲は、8〜50，60〜99、109〜137に固定
Set 行範囲 = Range("I8:N50,I60:N99,I109:N137").EntireRow
'▼アクティブセルの【列】で列範囲を決定する
Select Case ActiveCell.Column
Case 9 To 14
列範囲 = Range("I:N")
Case 24 To 29
列範囲 = Range("X:AC")
Case 39 To 44
列範囲 = Range("AM:AR")
Case 54 To 59
列範囲 = Range("BB:BG")
Case 69 To 74
列範囲 = Range("BQ:BV")
Case Else
MsgBox "アクティブセルの位置が想定外です" & vbLf & "処理を中止します"
Exit Sub
End Select
'▼処理範囲のセルを巡回して該当するセルを【一旦覚えておく（処理はしない）】
For Each tmpRNG In Intersect(行範囲, 列範囲)
With tmpRNG
If .Value = "" And .Interior.Color <> RGB(255, 183, 192) Then
If MyRNG Is Nothing Then
Set MyRNG = .Cells
Else
Set MyRNG = Union(MyRNG, .Cells)
End If
End If
End With
Next tmpRNG
'▼覚えていたセルがあったら【一気に】処理する
If Not MyRNG Is Nothing Then MyRNG.Value = "在庫あり〇"
End Sub
（もこな２ ） 2021/09/19(日) 17:24
Select Case ActiveCell.Column
アクティブセル（一列）が選択された場合（9〜14、24〜28、33〜44、54〜59、69〜74列）の各々の列を処理→ 複数列(Selection)たとえば９〜11列を選択した場合、９〜11列を処理するようにするにはコードを書きかえればいいのでしょうか？
一列ActiveCell→複数列Selectionの場合はSelect Case 〜 End Selectのコードで対応は可能でしょうか？ 申し訳ありません。
（正明） 2021/09/20(月) 07:27
（正明） 2021/09/20(月) 10:31
■４
＞一列ActiveCell〜
そもそも、勘違いがあるかもしれません。「ActiveCell」は１つしかありません。
複数の列を選択していようが、とびとびのセルを選択していようが同じです。
＞selectionの列範囲の取得とIntersectの引数の入れかたが全く解りません。
Intersectメソッドについて調べてみましたか？
「selection」とそれぞれの「列全体」が一部でも重なっていれば処理対象とすればよいでしょう。
＞Select Case 〜 End Selectのコードで対応は可能でしょうか？
無理・・・ではないかもしれませんが、複数の範囲が条件を満たす可能性がありますよね？
よって別のアプローチのほうが良いとおもいますよ。
たとえば、↓のように先に処理対象となる【列範囲】ピックアップしておくなどのほうが有効だとおもいます。
Sub 在庫あり〇_改二()
Dim 列範囲 As Range
Dim 処理範囲 As Range
Dim tmpRNG As Range, MyRNG As Range
Stop 'ブレークポイントの代わり
'▼処理対象となる列範囲を判定するループ
For Each 列範囲 In Range("I:N, X:AC, AM:AR, BB:BG, BQ:BV").Areas
If Not Intersect(Selection, 列範囲) Then
If 処理範囲 Is Nothing Then
Set 処理範囲 = 列範囲
Else
Set 処理範囲 = Union(処理範囲, 列範囲)
End If
End If
Next 列範囲
'▼↑で見つからなかったら処理中止
If 処理範囲 Is Nothing Then
MsgBox "処理対象なし"
Exit Sub
End If
For Each tmpRNG In Intersect(Range("I8:N50,I60:N99,I109:N137").EntireRow, 処理範囲)
With tmpRNG
If .Value = "" And .Interior.Color <> RGB(255, 183, 192) Then
If MyRNG Is Nothing Then
Set MyRNG = .Cells
Else
Set MyRNG = Union(MyRNG, .Cells)
End If
End If
End With
Next tmpRNG
If Not MyRNG Is Nothing Then MyRNG.Value = "在庫あり〇"
End Sub
（もこな２ ） 2021/09/20(月) 12:15
下記に修正すればいいかと。
If Not Intersect(Selection, 列範囲) Is Nothing Then
（hatena） 2021/09/20(月) 17:15
（もこな２ ） 2021/09/20(月) 18:13
再三になりますが、ちゃんとコードの研究はされてますか？
例えば↓はどのようなセル範囲になるとおもいますか？
Intersect(Range("I8:N50,I60:N99,I109:N137").EntireRow, Range("AM:AR"))
（もこな２ ） 2021/09/20(月) 20:56
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.