エクセルマクロFor Eachを1回で処理したい

2023/09/05 19:40

このQ&Aのポイント

エクセル2013で、For Each を1回で処理する方法について教えてください。
現在、For Each が2回回ってしまい、処理時間が長くなっています。if文を使用してandでつなげる方法を試しましたが、うまく機能しませんでした。
For Each を1回で処理するためには、どのような方法を取ればよいでしょうか。

ベストアンサー

エクセルマクロFor Eachを1回で処理したい

2014/07/25 21:22

エクセル2013です。以下のようなマクロを作成しました。 For Each が2回、回る為、処理時間が長いです。 For Each を１かいで済ませたくif文をandでつなげばといろいろ試しましたが、うまくできません。 For Each を１回で済ませるにはどうすればいいでしょうか？よろしくお願いします。 Sub 出荷済削除() Dim 対象セル As Range Dim 対象色 As Long Dim 対象色2 As Long Dim 最終行 Dim 最終列最終列 = Cells(8, Columns.Count).End(xlToLeft).Column '8行目の最終列を取得最終行 = Cells(Rows.Count, 1).End(xlUp).Row 'A列の最終行を取得 Application.ScreenUpdating = False '画面切替停止対象色 = Range("B8").Interior.Color 'セルB8の色を基準色とする For Each 対象セル In Range(Cells(10, 17), Cells(最終行, 最終列)) If 対象セル.Interior.Color = 対象色 Then 対象セル.ClearContents '基準色と同じ色のセルの値をクリアする Next 対象セル対象色2 = Range("A8").Interior.Color 'セルB8の色を基準色とする For Each 対象セル In Range(Cells(10, 17), Cells(最終行, 最終列)) If 対象セル.Interior.Color = 対象色2 Then 対象セル.ClearContents '基準色と同じ色のセルの値をクリアする Next 対象セル Application.ScreenUpdating = True '画面切替停止解除 End Sub

gx9wx
お礼率95% (440/460)

Excel（エクセル）
回答数3
ありがとう数3

みんなの回答 （3）
専門家の回答

質問者が選んだベストアンサー

ベストアンサー

keithin
ベストアンサー率66% (5278/7940)

2014/07/25 21:49 回答No.1

Sub 出荷済削除() Dim 対象セル As Range Dim 対象色 As Long Dim 対象色2 As Long Dim 最終行 Dim 最終列最終列 = Cells(8, Columns.Count).End(xlToLeft).Column '8行目の最終列を取得最終行 = Cells(Rows.Count, 1).End(xlUp).Row 'A列の最終行を取得 Application.ScreenUpdating = False '画面切替停止対象色 = Range("B8").Interior.Color 'セルB8の色を基準色とする対象色2 = Range("A8").Interior.Color 'セルA8の色を基準色とする For Each 対象セル In Range(Cells(10, 17), Cells(最終行, 最終列)) If 対象セル.Interior.Color = 対象色 or 対象セル.Interior.Color = 対象色2 Then 対象セル.ClearContents '基準色「1または2と同じ」色のセルの値をクリアする Next 対象セル Application.ScreenUpdating = True '画面切替停止解除 End Sub

質問者

お礼 2014/07/28 19:40

申しあわけありません。確かにorでした。ありがとうございます。

その他の回答 (2)

K Kazz（@JazzCorp）
ベストアンサー率31% (549/1751)

2014/07/25 22:13 回答No.3

Option Explicit Sub 出荷済削除() Dim 対象セル As Range Dim 対象色 As Long Dim 対象色2 As Long Dim 最終行 As Long Dim 最終列 As Long Application.ScreenUpdating = False '画面切替停止 'For Each 対象セル In Range(Cells(10, 17), Cells(最終行, 最終列)) ' If 対象セル.Interior.Color = 対象色 Then '対象セル.ClearContents '基準色と同じ色のセルの値をクリアする 'endif 'Next 対象セル最終列 = Cells(8, Columns.Count).End(xlToLeft).Column '8行目の最終列を取得最終行 = Cells(Rows.Count, 1).End(xlUp).Row 'A列の最終行を取得対象色 = Range("B8").Interior.Color 'セルB8の色を基準色とする対象色2 = Range("A8").Interior.Color 'セルB8の色を基準色とする For Each 対象セル In Range(Cells(10, 17), Cells(最終行, 最終列)) Debug.Print 対象セル.Row, 対象セル.Column, 対象セル.Interior.Color, 対象色, 対象色2 If (対象セル.Interior.Color = 対象色) Or (対象セル.Interior.Color = 対象色2) Then 対象セル.ClearContents '基準色と同じ色のセルの値をクリアする End If Next 対象セル Application.ScreenUpdating = True '画面切替停止解除 End Sub

質問者

お礼 2014/07/28 19:42

If (対象セル.Interior.Color = 対象色) Or (対象セル.Interior.Color = 対象色2) Then 対象セル.ClearContents 前の方の回答では（　　）でくくられていませんがそれでも動作しました。（　　）でくくる、くくらないがいまいちわかっておりません。ありがとうございました。

kkkkkm
ベストアンサー率65% (1620/2459)

2014/07/25 21:57 回答No.2

and ではなくて　or ではないでしょうか。対象色 = Range("B8").Interior.Color 'セルB8の色を基準色とする対象色2 = Range("A8").Interior.Color 'セルB8の色を基準色とする For Each 対象セル In Range(Cells(10, 17), Cells(最終行, 最終列)) If 対象セル.Interior.Color = 対象色 or 対象セル.Interior.Color = 対象色2 Then 対象セル.ClearContents '基準色と同じ色のセルの値をクリアする Next 対象セル

質問者

お礼 2014/07/28 19:40

申しあわけありません。確かにorでした。ありがとうございます。

関連するQ&A

エクセルマクロFor Eachの処理が長い
エクセル2013です。皆さんに教えていただいて以下のマクロが完成しました。サンプルデータ３０行、7列ではあっという間に処理ができたのですが本番環境 800行、50列ですと処理時間が長く青丸がくるくる回っていて、2分後にくらいで終わります。もう少し早く処理する方法はありますでしょうか？ Findで検索して、一括削除？（それはマクロでできるのでしょうか？）よろしくお願いします。 Sub 出荷済削除() Dim 対象セル As Range Dim 対象色 As Long Dim 対象色2 As Long Dim 最終行 Dim 最終列最終列 = Cells(8, Columns.Count).End(xlToLeft).Column '8行目の最終列を取得最終行 = Cells(Rows.Count, 1).End(xlUp).Row 'A列の最終行を取得 Application.ScreenUpdating = False '画面切替停止対象色 = Range("B8").Interior.Color 'セルB8の色を基準色とする対象色2 = Range("A8").Interior.Color 'セルB8の色を基準色とする For Each 対象セル In Range(Cells(10, 17), Cells(最終行, 最終列)) If 対象セル.Interior.Color = 対象色 Or 対象セル.Interior.Color = 対象色2 Then 対象セル.ClearContents Next 対象セル Application.ScreenUpdating = True '画面切替停止解除 End Sub
- ベストアンサー
- Excel（エクセル）
マクロセルの値によってセルの色を消す
エクセル2013です。セルの値が0又は空白の場合でそのセルが色塗りされていたら色を消すというマクロをを作成しました。ただ700行55列では処理が遅いです。 Sub 色消() '成功 Dim 最終行 Dim 最終列 Dim 対象セル As Range 最終列 = Cells(8, Columns.Count).End(xlToLeft).Column '8行目の最終列を取得最終行 = Cells(Rows.Count, 1).End(xlUp).Row 'A列の最終行を取得 For Each 対象セル In Range(Cells(10, 17), Cells(最終行, 最終列)) If 対象セル.Value = 0 Or 対象セル = "" Then 対象セル.Interior.ColorIndex = 0 End If Next 対象セル End Sub 対象範囲から対象セルを全部見つけて一括処理すれば早いのではと以下のマクロを作成してみましたが Set 対象範囲 = Cells.Find(What:=0 Or "", LookIn:=xlValues, LookAt:=xlWhole) で構文ERRです。どこを直せばいいのでしょうか？よろしくお願いします。 Sub 色消2() '2014/8/4 '失敗 Dim 対象範囲 Dim 最終行 Dim 最終列最終列 = Cells(8, Columns.Count).End(xlToLeft).Column '8行目の最終列を取得最終行 = Cells(Rows.Count, 1).End(xlUp).Row 'A列の最終行を取得対象範囲 = Range(Cells(10, 17), Cells(最終行, 最終列)) Set 対象範囲 = Cells.Find(What:=0 Or "", LookIn:=xlValues, LookAt:=xlWhole) If Not 対象範囲 Is Nothing Then 対象範囲.Interior.ColorIndex = 0 End If End Sub
- ベストアンサー
- Excel（エクセル）
エクセルマクロ行削除
エクセル2013です。以下の行削除マクロを作りました。取得した最終行が２０行目として最終列がＺ列としてセル　Z20　の値が１以上なら問題なく動作するのですがセル　Z20　の値が　0　だとループして終了しません。どこを修正しても、思うように動作しません。どこを修正すれば、いいのでしょうか？よろしくお願いします。 Sub 行削除() Dim 最終行 Dim 最終列 Dim 対象行最終列 = Cells(8, Columns.Count).End(xlToLeft).Column '8行目の最終列を取得最終行 = Cells(Rows.Count, 1).End(xlUp).Row 'A列の最終行を取得 Application.ScreenUpdating = False '画面切替停止 For 対象行 = 10 To 最終行 If Cells(対象行, 最終列) = 0 Then Rows(対象行).Delete 最終行 = 最終行 - 1 '削除により最終行が１行減ったので最終行の値を1行減らす対象行 = 対象行 - 1 '削除により対象行が1行繰り上がったので対象行の値を1行減らす Else End If Next 対象行 Application.ScreenUpdating = True '画面切替停止解除 End Sub
- ベストアンサー
- Excel（エクセル）
マクロで教えてください。
sheet1のA列にある図番を参照しsheet2のA列の機種名に適合する行全体に sheet1のB列にある色を塗りたいのですが、マクロを教えていただけますでしょうか？ sheet2のBのセル色を塗るマクロはわかりました。↓です。 Sub macro1() Dim c As Range, myR As Variant With Sheets("Sheet2") For Each c In .Range("a2", .Cells(Rows.Count, "a").End(xlUp)) myR = Application.Match(c.Value, Sheets("sheet1").Columns(1), 0) If Not IsError(myR) Then c.Offset(, 1).Interior.ColorIndex = Sheets("sheet1").Cells(myR, "B").Interior.ColorIndex End If Next End With End Sub 上記マクロですとBセルのみ色が塗られてしまうので行全体を塗るマクロを教えてください。よろしくお願い致します。
- ベストアンサー
- オフィス系ソフト
エクセルマクロで教えてください
Sub smp05_14_01() Dim 対象セル As Range Dim ws1 As Worksheet Dim ws2 As Worksheet Dim ws3 As Worksheet Dim 行 As Long, 列 As Long Dim i As Long Set ws1 = Worksheets("顧客") Set ws2 = Worksheets("売上") Set ws3 = Worksheets("顧客未登録") 行 = ws1.Range("A1").End(xlDown).Row - 1 列 = ws1.Range("A1").End(xlToRight).Column Set 対象セル = ws1.Cells(1, 列 + 2).Resize(2, 行) For i = 1 To 行対象セル(1, i).Value = "顧客NO" 対象セル(2, i).Value = "<>" & ws1.Cells(i + 1, 1) Next ws2.Range("A1").CurrentRegion.AdvancedFilter _ Action:=xlFilterCopy, _ CriteriaRange:=対象セル, _ CopyToRange:=ws3.Range("A1") 対象セル.Clear End Sub 上記のマクロは売上のシートに登録されている以外の顧客NOを顧客シートを参照して顧客未登録シートにコピーするのもですが添付したファイルの数だと上手くいくのですが、エクセルのヨコのセルの最大値の258を越えると上手くいきません。上記の処理で1000レコードを越えても売上シートに登録されている以外の顧客NOを参照して顧客未登録シートにコピーするマクロを教えてください。
- 締切済み
- オフィス系ソフト
エクセルマクロ配列で変数は使えますか
エクセル2013です。初めて配列を使います。以下のように作成し思ったようにできました。 Sub 計算() '成功 Dim a As Integer Dim c As Integer Dim b(5) As Integer Dim 最終行 Dim 値列　値列 = 17 最終行 = Cells(Rows.Count, 1).End(xlUp).Row For 処理業 = 1 To 最終行 For a = 1 To 5 b(a - 1) = Cells(1, 値列) 値列 = 値列 + 1 Next 値列 = 17 For a = 1 To (22 - 値列) c = c + b(a - 1) Next Cells(処理業, 30) = c a = 0 c = 0 Next 処理業 End Sub ただ計算する列の範囲をインプットボックスで入力した値にしたい為以下のように改造しました。 Dim b(対象列) As Integerでエラーになります配列には変数は使用できないのでしょうか？よろしくお願いします。 Sub 計算() '失敗 Dim a As Integer Dim c As Integer Dim b(対象列) As Integer’★ここでERRになる Dim 最終行 Dim 対象列 Dim 値列　対象列 = 22'インプットボックスで入力した値値列 = 17 最終行 = Cells(Rows.Count, 1).End(xlUp).Row For 処理業 = 1 To 最終行 For a = 1 To (対象列 - 17) b(a - 1) = Cells(1, 値列) 値列 = 値列 + 1 Next 値列 = 17 For a = 1 To (22 - 値列) c = c + b(a - 1) Next Cells(処理業, 30) = c a = 0 c = 0 Next 処理業 End Sub
- ベストアンサー
- Excel（エクセル）
このコード（For Each…）ですが、うまく実行できません！
EXEL 2002　です。下記コードなのですが、　うまくできません、「For Each…」の下2行がエラーとなります。何卒、ご教示よろしくお願い致します。 -------------------- Sub 下方表の各列を上方へ貼付る() '下方の表の各列を、上方に貼り付ける Dim r As Range With Worksheets(Worksheets.Count - 1) For Each r In .Range("G40:Z40") .Range(r.Offset(0, 0), .Range(r.Offset(0, 0)).End(xlDown)).Copy _ .Range (r.Offset(-38, 1)) Next r End With End Sub
- ベストアンサー
- オフィス系ソフト
エクセル　マクロ　抽出
教えてください。 ○と記入されたセルを参照して、一つ上のセル・A列にある同じ行のセル・ 9行目にある同じ列のセルを抽出しようとしています。下記の通り入力すると　行数＝値.Rowでエラーが出たしまいました。試行錯誤頑張りましたが解決できそうにありませんのでお力を貸して頂けないでしょうか。 Sub 抽出() Dim i, 行数, 列数 As Long Dim 値 As Range i = 0 行数 = 値.Row 列数 = 値.Column For Each 値 In Sheets("sheet1").Range("C12:R171") If 値.Value = "○" Then i = i + 1 With Sheets("sheet2") .Cells(i, 3).Value = Sheets("sheet1").Cells(行数, 1).Value .Cells(i, 4).Value = Sheets("sheet1").Cells(9, 列数).Value .Cells(i, 5).Value = 値.Offset(-1, 0).Value End With End If Next End Sub
- ベストアンサー
- オフィス系ソフト
エクセルマクロで教えてください
マクロ初心者です。アドバイスをお願いします。以下のマクロですとB列の100行目までの塗りつぶしのセルのカウントは出来るのですが、シート上の全てをカウントしたいのです。１TO 100の100の部分をどう変更したら良いのか教えてください。 Sub セルの色数1() Dim I As Integer Dim Count As Integer Count = 0 For I = 1 To 100 If Cells(I, 2).Interior.ColorIndex <> xlNone Then Count = Count + 1 Next I Range("C1").Value = Count End Sub
- 締切済み
- その他(業務ソフトウェア)
セルに対してFor Each～In～Nextを使う
セルに対してFor Each～In～Nextを使う事は出来ない？シートやブックに対してループする時は Sub aaa() Dim w As Worksheet For Each w In Worksheets MsgBox w.Name Next End Sub 等を使いますが、Ａ１に「あ」Ａ２に「い」Ａ３に「う」が入っている場合、 Sub bbb() Dim i As Long For i = 1 To Range("a65536").End(xlUp).Row MsgBox Cells(i, 1) Next End Sub で、全ての値を取得できますが、 For～to～nextではなくセルに対してFor Each～In～Nextを使う方法があれば教えてください。上記のように Dim w As Worksheetは宣言できますが Dim c As Workcellとはできませんでした。なぜわざわざFor～to～nextでできる事をFor Each～In～Nextでやりたいかと言うと、シートやブックはFor～to～nextでできるのに、セルはFor～to～nextができない理由を知りたいからです。ご回答よろしくお願いします。
- ベストアンサー
- オフィス系ソフト