Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Home : Excel 2016)
For Each   Next ステートメントの使い方について
投稿日時: 17/11/13 16:57:24
投稿者: Dellcasio

お世話になります。
For Each   Next ステートメントの使い方ですが、
Z列とU列とO列をまとめてMyRange、MyRange2、MyRange3
オブジェクト変数に取込むには、どのようにコードを
書けば良いのか分かりません。
どなたか教えて頂けないでしょうか?
 
尚、下のコードは無限ループになります。
 
よろしくお願い致します。
 
 
 
Sub 追加送料()
    Dim MyRange As Range
    Dim MyRange2 As Range
    Dim MyRange3 As Range
    Dim MyRange4 As Range
    Dim R1
    Dim RR1
     
 
  
  
    R1 = Worksheets("伝票データ作成").Cells(Rows.Count, "Z").End(xlUp).Row
    RR1 = Worksheets("@請求一覧").Cells(Rows.Count, "B").End(xlUp).Row
  
    For Each MyRange In Worksheets("伝票データ作成").Range("Z2 :Z" & R1)
     For Each MyRange3 In Worksheets("伝票データ作成").Range("U2 :U" & R1)
       For Each MyRange4 In Worksheets("伝票データ作成").Range("O2 :O" & R1)
        If Not IsEmpty(MyRange.Value) Then
            For Each MyRange2 In Worksheets("@請求一覧").Range("B2 :B" & RR1)
                If MyRange.Value = MyRange2.Value And _
                     MyRange3.Value = 0 And _
                     MyRange4.Value <> "Z" Then
                     MyRange.Interior.ColorIndex = 34
                End If
            Next
        End If
       Next
     Next
    Next
     
End Sub
 

回答
投稿日時: 17/11/13 17:30:39
投稿者: もこな2

どうしてもFor Each Next じゃなきゃだめでしょうか?
こんな方法もありそうな気が。。。

Sub 追加送料()
    Dim MyRange As Range
    Dim MyRange2 As Range
    Dim MyRange3 As Range
    Dim MyRange4 As Range
    Dim R1
    Dim RR1

    Dim i As Long 'カウント用

     'オブジェクトセット−−−−−−−−−−−−−−−−−−−−−−−−−−−
    With Worksheets("伝票データ作成")
        Set MyRange = .Range("Z2 :Z" & R1)
        Set MyRange3 = .Range("U2 :U" & R1)
        Set MyRange4 = .Range("O2 :O" & R1)
    End With

        Set MyRange2 = Worksheets("@請求一覧").Range("B2 :B" & RR1)
    '−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−

  '最終行セット−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
    R1 = Worksheets("伝票データ作成").Cells(Rows.Count, "Z").End(xlUp).Row
    RR1 = Worksheets("@請求一覧").Cells(Rows.Count, "B").End(xlUp).Row
    '−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−

    '実処理−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
    For i = 1 To MyRange2.Count
        If MyRange(i).Value = MyRange2(i).Value And _
            MyRange3(i).Value = 0 And _
            MyRange4(i).Value <> "Z" Then
            MyRange(i).Interior.ColorIndex = 34
        End If
    Next i
    '−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−−
End Sub

回答
投稿日時: 17/11/13 17:47:32
投稿者: Suzu

Dellcasio さんの引用:
下のコードは無限ループになります。

 
無限ループにはなっていません。
引用:
R1 = Worksheets("伝票データ作成").Cells(Rows.Count, "Z").End(xlUp).Row

 

 
アクティブシートの、行数を取得し、
シート「伝票データ作成」の Z列で、先に取得した行数と同じセル位置から
 ctl+Up にて 取得できるセル位置の、行 の位置を取得
 
あくまでアクティブシートのセルです。 シート伝票データ作成の 行数ではありませんよ。
 
 
引用:
For Each MyRange In Worksheets("伝票データ作成").Range("Z2 :Z" & R1)
     For Each MyRange3 In Worksheets("伝票データ作成").Range("U2 :U" & R1)
       For Each MyRange4 In Worksheets("伝票データ作成").Range("O2 :O" & R1)
         ※

 
※の位置の各オブジェクト変数の中身がどう動くか理解されていますでしょうか。
仮にR1が 3だとします。
 
MyRange : Z2、MyRange3 : U2、MyRange4 : O2
MyRange : Z2、MyRange3 : U2、MyRange4 : O3
MyRange : Z2、MyRange3 : U3、MyRange4 : O2
MyRange : Z2、MyRange3 : U3、MyRange4 : O3
MyRange : Z3、MyRange3 : U2、MyRange4 : O2
MyRange : Z3、MyRange3 : U2、MyRange4 : O3
MyRange : Z3、MyRange3 : U3、MyRange4 : O2
MyRange : Z3、MyRange3 : U3、MyRange4 : O3
 
の順番で取得します。
 
つまり、(R1 -1)^3 通りの 処理を行っています。
R1が3の時には、2^3=8通り
R2が4の時には、3^3=27通り
R2が5の時には、4^3=64通り
R2が6の時には、5^3=125通り
はい。
 
R2が 100の時は・・ 99^3 = 970,299 通り
 
時間が掛かりますよね。
 
For Each で、何をおやりになりたいのでしょう?
 
For i = 2 To R1
 Set MyRange = Worksheets("伝票データ作成").Range("Z" & i )
 Set MyRange3 = Worksheets("伝票データ作成").Range("U" & i )
 Set MyRange4 = Worksheets("伝票データ作成").Range("O" & i )
Next i
 
ではダメなのですか?

回答
投稿日時: 17/11/13 17:49:14
投稿者: もこな2

自分の方法だと 「 R1 」と 「RR1」 が一致しているのが前提になりますが。。。
  
P.S.
「オブジェクトセット」と「最終行セット」の順番逆ですね。。。失礼しました。

投稿日時: 17/11/13 18:14:33
投稿者: Dellcasio

Suzu さんの引用:
Dellcasio さんの引用:
下のコードは無限ループになります。

 
無限ループにはなっていません。
引用:
R1 = Worksheets("伝票データ作成").Cells(Rows.Count, "Z").End(xlUp).Row

 

 
アクティブシートの、行数を取得し、
シート「伝票データ作成」の Z列で、先に取得した行数と同じセル位置から
 ctl+Up にて 取得できるセル位置の、行 の位置を取得
 
あくまでアクティブシートのセルです。 シート伝票データ作成の 行数ではありませんよ。
 
 
引用:
For Each MyRange In Worksheets("伝票データ作成").Range("Z2 :Z" & R1)
     For Each MyRange3 In Worksheets("伝票データ作成").Range("U2 :U" & R1)
       For Each MyRange4 In Worksheets("伝票データ作成").Range("O2 :O" & R1)
         ※

 
※の位置の各オブジェクト変数の中身がどう動くか理解されていますでしょうか。
仮にR1が 3だとします。
 
MyRange : Z2、MyRange3 : U2、MyRange4 : O2
MyRange : Z2、MyRange3 : U2、MyRange4 : O3
MyRange : Z2、MyRange3 : U3、MyRange4 : O2
MyRange : Z2、MyRange3 : U3、MyRange4 : O3
MyRange : Z3、MyRange3 : U2、MyRange4 : O2
MyRange : Z3、MyRange3 : U2、MyRange4 : O3
MyRange : Z3、MyRange3 : U3、MyRange4 : O2
MyRange : Z3、MyRange3 : U3、MyRange4 : O3
 
の順番で取得します。
 
つまり、(R1 -1)^3 通りの 処理を行っています。
R1が3の時には、2^3=8通り
R2が4の時には、3^3=27通り
R2が5の時には、4^3=64通り
R2が6の時には、5^3=125通り
はい。
 
R2が 100の時は・・ 99^3 = 970,299 通り
 
時間が掛かりますよね。
 
For Each で、何をおやりになりたいのでしょう?
 
For i = 2 To R1
 Set MyRange = Worksheets("伝票データ作成").Range("Z" & i )
 Set MyRange3 = Worksheets("伝票データ作成").Range("U" & i )
 Set MyRange4 = Worksheets("伝票データ作成").Range("O" & i )
Next i
 
ではダメなのですか?

 
 
 
Suzuさん、
ご回答ありがとうございます。
 
>>For Each で、何をおやりになりたいのでしょう?
 
やりたいことは、計算時間の短縮です。
 
以前は、For Next ステートメントばかり使用していたのですが、
計算に時間が掛かるので For Each Nextステートメントを使いたいのです。
なので今は、For Each Nextステートメントを勉強している最中です。
 
 

回答
投稿日時: 17/11/13 18:35:22
投稿者: もこな2

失礼しました。
 
自分のだと、 「伝票データ作成」と「@請求一覧」の行番号が同じものしか処理しないですね。
提示したコードは無視してください

回答
投稿日時: 17/11/13 18:39:55
投稿者: はぶ

失礼します。
 
時間短縮の工夫はしていませんが、
もし、Z列と@請求一覧シートのB列の比較でしたら
次のような感じでしょうか。
 
    Dim R1 As Long
    Dim RR1 As Long
    Dim i As Long
    Dim e As Variant
    Dim ws As Worksheet
    Dim ws1 As Worksheet
 
    Set ws = Worksheets("伝票データ作成")
    Set ws1 = Worksheets("@請求一覧")
 
    R1 = ws.Cells(Rows.Count, "Z").End(xlUp).Row
    RR1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row
 
    For i = 2 To R1
      If ws.Cells(i, "O").Value <> "Z" Then
        If ws.Cells(i, "U").Value = 0 Then
          If ws.Cells(i, "Z").Value <> "" Then
 
            For Each e In ws1.Range("B2 :B" & RR1)
              If ws.Cells(i, "Z").Value = e.Value Then
                ws.Cells(i, "Z").Interior.ColorIndex = 34
              End If
            Next
 
          End If
        End If
      End If
    Next
      
    Set ws = Nothing
    Set ws1 = Nothing

投稿日時: 17/11/13 19:14:29
投稿者: Dellcasio

もこな2 さんの引用:
失礼しました。
 
自分のだと、 「伝票データ作成」と「@請求一覧」の行番号が同じものしか処理しないですね。
提示したコードは無視してください

 
 
もこな2さん
ご回答ありがとうございました。
承知致しました。
 
 

投稿日時: 17/11/13 19:26:37
投稿者: Dellcasio

はぶ さんの引用:
失礼します。
 
時間短縮の工夫はしていませんが、
もし、Z列と@請求一覧シートのB列の比較でしたら
次のような感じでしょうか。
 
    Dim R1 As Long
    Dim RR1 As Long
    Dim i As Long
    Dim e As Variant
    Dim ws As Worksheet
    Dim ws1 As Worksheet
 
    Set ws = Worksheets("伝票データ作成")
    Set ws1 = Worksheets("@請求一覧")
 
    R1 = ws.Cells(Rows.Count, "Z").End(xlUp).Row
    RR1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row
 
    For i = 2 To R1
      If ws.Cells(i, "O").Value <> "Z" Then
        If ws.Cells(i, "U").Value = 0 Then
          If ws.Cells(i, "Z").Value <> "" Then
 
            For Each e In ws1.Range("B2 :B" & RR1)
              If ws.Cells(i, "Z").Value = e.Value Then
                ws.Cells(i, "Z").Interior.ColorIndex = 34
              End If
            Next
 
          End If
        End If
      End If
    Next
      
    Set ws = Nothing
    Set ws1 = Nothing

 
はぶさん、
ご回答ありがとうございました。
うまく出来ました。
ありがとうございます。
 
 
 
>>時間短縮の工夫はしていませんが
もしよろしければ時間短縮した方法も
教えて頂けないでしょうか?
よろしくお願い致します。
 
 

回答
投稿日時: 17/11/13 19:29:41
投稿者: もこな2

さきほどは失礼しました・
 
本件はやりたいことの整理が必要ですね。
やりたいことが、Worksheets("伝票データ作成")のZ列のn行セルについて、
 セルの値が空白でなく
 セルの値と一致するものがWorksheets("@請求一覧").のB列のなかにある場合であって
 Worksheets("伝票データ作成")のU列のなかに、0という値を持つものがあって
 Worksheets("伝票データ作成")のO列のなかに、大文字の「Z」以外の値を持つものがあれば
自セルを塗りつぶし
 
なら、提示のコードでよいとおもいます。
 
ただ、この場合計算時間の短縮を考えるなら、下位のFor Each   Nextに行く前に
条件分岐させるべきでは?
(例、セルの値が空白であるなら、下位のFor Eachを回すまでも無く条件に一致しない)
 
また、塗りつぶしたものを取り消すような操作がないので、1度塗りつぶせば、何度も塗りつぶししなくてよいですよね
したがって、塗りつぶしをしたあと、For Each   Next群から抜ける処理をすれば、無駄がないとおもいます。
 
 
 

投稿日時: 17/11/13 19:40:01
投稿者: Dellcasio

もこな2 さんの引用:
さきほどは失礼しました・
 
本件はやりたいことの整理が必要ですね。
やりたいことが、Worksheets("伝票データ作成")のZ列のn行セルについて、
 セルの値が空白でなく
 セルの値と一致するものがWorksheets("@請求一覧").のB列のなかにある場合であって
 Worksheets("伝票データ作成")のU列のなかに、0という値を持つものがあって
 Worksheets("伝票データ作成")のO列のなかに、大文字の「Z」以外の値を持つものがあれば
自セルを塗りつぶし
 
なら、提示のコードでよいとおもいます。
 
ただ、この場合計算時間の短縮を考えるなら、下位のFor Each   Nextに行く前に
条件分岐させるべきでは?
(例、セルの値が空白であるなら、下位のFor Eachを回すまでも無く条件に一致しない)
 
また、塗りつぶしたものを取り消すような操作がないので、1度塗りつぶせば、何度も塗りつぶししなくてよいですよね
したがって、塗りつぶしをしたあと、For Each   Next群から抜ける処理をすれば、無駄がないとおもいます。
 
 
 

 
 
もこな2さん、
ご回答ありがとうございました。
 
ご指示を頂いた事を検討して参ります。
ありがとうございました。
 
 
 
 
 
 
 

回答
投稿日時: 17/11/13 21:44:38
投稿者: もこな2

引用:
塗りつぶしをしたあと、For Each   Next群から抜ける処理をすれば

群全体を抜けてはダメですね。塗りつぶしをされているなら処理しないということですかね。
 
たとえばこんな感じかなとおもいます。(説明はコード下にあります)
Sub 追加送料()
    Dim MyRange As Range
    Dim MyRange2 As Range
    Dim MyRange3 As Range
    Dim MyRange4 As Range
    Dim R1
    Dim RR1
     
    Dim WS1 As Worksheet, WS2 As Worksheet
  
    Set WS1 = Worksheets("伝票データ作成") '--追@
    Set WS2 = Worksheets("@請求一覧") '--追A
      
    R1 = Worksheets("伝票データ作成").Cells(Rows.Count, "Z").End(xlUp).Row
    RR1 = Worksheets("@請求一覧").Cells(Rows.Count, "B").End(xlUp).Row
  

    For Each MyRange In .Range("Z2 :Z" & R1)
        If MyRange.Interior.ColorIndex <> 34 And Not IsEmpty(MyRange.Value) Then '−−@
            For Each MyRange2 In WS2.Range("B2 :B" & RR1)
                If MyRange.Interior.ColorIndex <> 34 And MyRange.Value = MyRange2.Value Then '−−A
                    For Each MyRange3 In WS1.Range("U2 :U" & R1)
                        If MyRange.Interior.ColorIndex <> 34 And MyRange3.Value = 0 Then '−−B
                            For Each MyRange4 In WS1.Range("O2 :O" & R1)
                                If MyRange.Interior.ColorIndex <> 34 And MyRange4.Value <> "Z" Then '−−C
                                    MyRange.Interior.ColorIndex = 34
                                End If
                            Next
                        End If
                    Next
                End If
            Next
        End If
    Next

End Sub

追@なんどもおなじシートが出てきて書きづらかったのでオブジェクトを追加しました
追A  〃
どちらかは、Withステートメントでまとめてしまってもよいかも
 
@MyRangeが塗りつぶしされていなくて、MyRangeの値が空白でないなら以下処理を実行
AMyRangeが塗りつぶしされていなくて、RangeとRange2の値が一致するなら以下処理を実行
BMyRangeが塗りつぶしされていなくて、MyRange3の値が0なら以下処理を実行(ただ、MyRange3が空白でも実行されそうな気が・・・)
CMyRangeが塗りつぶしされていなくて、MyRange4が「Z」(大文字の"Z"に完全一致)するなら以下の処理を実行
 
このようにすればMyRangeが塗りつぶされた段階で、以降、下位のコードは実行しなくなるので、無駄な判定はしなくて済むようにおもいます。
 
このほか可読性の観点から、「MyRange.Interior.ColorIndex <> 34」の判定を毎回するのではなくBoolean型のフラグを用意してフラグ管理をしてみたり、IF文について、Elseがないので、条件 then 処理 と1行で記載して End IF を省略するというようなこともできるように思いますが、その辺はお好みということで・・

回答
投稿日時: 17/11/13 21:51:32
投稿者: もこな2

[quote="もこな2"]

引用:

CMyRangeが塗りつぶしされていなくて、MyRange4が「Z」(大文字の"Z"に完全一致)するなら以下の処理を実行
お気づきだと思いますが、
CMyRangeが塗りつぶしされていなくて、MyRange4が「Z」(大文字の"Z"に完全一致)しないなら以下の処理を実行
ですね、失礼しました。

回答
投稿日時: 17/11/13 23:57:18
投稿者: baoo

まず、処理されたいことを文章で考えてみることが大事です。
コードからの勝手な想像になりますが望まれているのは、
 
・伝票データ作成シートのZ列のセルが空でない。
・そのZ列のセルの値と@請求一覧シートのB列に同じ値がある。
・そのZ列のセルと同じ行のU列の値が0である。
・そのZ列のセルと同じ行のO列の値が"Z"である。
 
以上の条件にすべて合致した場合にそのZ列の値のセルの色を34にするという処理でしょうか?
考え方を変えると伝票データ作成シートの各行を見て、U列が0、O列が"Z"、Z列が空でない時に
Z列の値が@請求一覧シートのB列にあればそのセルの色を34にするということになります。
 
高速な処理を考えるならRangeを2次元配列に入れるという方法があります。
(参照:http://officetanaka.net/excel/vba/speed/s11.htm)
伝票データ作成のデータを2次元配列に入れる。
で、Z列の値が@請求一覧シートのB列にあるかどうかをチェックするだけなら
@請求一覧シートのB列でZ列の値を検索すれば良い。
したがって@請求一覧シートでは繰り返しをする必要はありません。
処理を考えると
 
1.伝票データ作成シートのA列〜Z列のデータを2次元配列に入れる。
2.For Nextを使って各行のU列="Z"、O列=0、Z列が空でないときに次の3を行う。
3.Z列の値を@請求一覧シートのB列で検索して見つかればそのZ列のセルの色を34にする。
4.上記2、3を繰り返す。
 
以上をコードにします。

Sub test1()
    
    Dim Rng As Variant
    Dim lngEndRow As Long   'Dim R1 As Long <- R1じゃ分かりにくいので変えますね。
    Dim i As Long
    Dim cl As Range
    Dim sht As Worksheet
    Dim t As Double        '速度チェック用
    
    t = Timer
    
    Set sht = Worksheets("@請求一覧")
    
    With Worksheets("伝票データ作成")
        lngEndRow = .Cells(.Rows.Count, 26).End(xlUp).Row

        'A列からZ列までのデータ(列番号をそのまま使うためにA列からとした。)
        Rng = .Range(.Cells(2, 1), .Cells(lngEndRow, 26))

        'シート2行目が2次元配列1行目に注意。シートの行番号に直す場合は+1
        For i = 1 To lngEndRow - 1
            If Rng(i, 15) = "Z" And Rng(i, 21) = 0 And (Not IsEmpty(Rng(i, 26))) Then
                Set cl = sht.Columns("B:B").Find(Rng(i, 26), LookAt:=xlWhole)
                If Not cl Is Nothing Then
                    .Cells(i + 1, 26).Interior.ColorIndex = 34    
                End If
            End If
        Next i
    End With
    
    Debug.Print Timer - t
    
End Sub

 
 

回答
投稿日時: 17/11/14 08:57:07
投稿者: mattuwan44

Dellcasio さんの引用:
お世話になります。
For Each   Next ステートメントの使い方ですが、
Z列とU列とO列をまとめてMyRange、MyRange2、MyRange3
オブジェクト変数に取込むには、どのようにコードを
書けば良いのか分かりません。
どなたか教えて頂けないでしょうか?
 
尚、下のコードは無限ループになります。
 
よろしくお願い致します。
 
 
 
Sub 追加送料()
    Dim MyRange As Range
    Dim MyRange2 As Range
    Dim MyRange3 As Range
    Dim MyRange4 As Range
    Dim R1
    Dim RR1
     
 
  
  
    R1 = Worksheets("伝票データ作成").Cells(Rows.Count, "Z").End(xlUp).Row
    RR1 = Worksheets("@請求一覧").Cells(Rows.Count, "B").End(xlUp).Row
  
    For Each MyRange In Worksheets("伝票データ作成").Range("Z2 :Z" & R1)
     For Each MyRange3 In Worksheets("伝票データ作成").Range("U2 :U" & R1)
       For Each MyRange4 In Worksheets("伝票データ作成").Range("O2 :O" & R1)
        If Not IsEmpty(MyRange.Value) Then
            For Each MyRange2 In Worksheets("@請求一覧").Range("B2 :B" & RR1)
                If MyRange.Value = MyRange2.Value And _
                     MyRange3.Value = 0 And _
                     MyRange4.Value <> "Z" Then
                     MyRange.Interior.ColorIndex = 34
                End If
            Next
        End If
       Next
     Next
    Next
     
End Sub
 

 
高速化を目指すなら、
1)条件式をAndで繋がない。
Andで繋ぐと、どれかの条件式の評価が偽になっても、全部いちいち読んで評価することになるので、
Ifの入れ子にして、1個でも偽の条件ならその後の条件式を評価しないようにしましょう。
 
2)オブジェクト変数を上手く使う。
例えば
>Worksheets("伝票データ作成").Range("U2 :U" & R1)
↑ここが実行されるとき、
毎回、
Activeブックの"伝票データ作成"シートのU列の同じ行をとうろうろ探すことになります。
折角myRangeにセルが格納されているのですから、
そのセルの何個左のセル
と表現すれば、参照が簡単になります。
あれ、コードでそれが表現できてないけど、そういうことをやりたいんですよね?(同じ行)
 
Sub test()
    Dim rngData As Range
    Dim rngList As Range
    Dim c As Range
     
    With Worksheets("伝票データ作成")
        Set rngData = Application.Range(.Range("Z2"), .Cells(.Rows.Count, "Z").End(xlUp))
    End With
    With Worksheets("@請求一覧")
        Set rngList = Application.Range(.Range("B2"), .Cells(.Rows.Count, "B").End(xlUp))
    End With
     
    For Each c In rngData
        With c
            If .Offset(, -11).Value <> "Z" Then 'O列?
                If .Offset(, -5).Value = 0 Then 'U列?
                    If WorksheetFunction.CountIf(rngList, .Value) > 1 Then
                        .Interior.ColorIndex = 34
                    End If
                End If
            End If
        End With
    Next
End Sub
 
あと、With句を使うと、似たような変数名の変数をたくさん用意しなくてもよくなる
(変数名の無い変数を使うということです。)ので、
コードがすっきりするかなぁと思います。
 
※オフセット量を数え間違えてたらごめんなさい
※ワークシート関数を使って評価してみましたが、
見た目のループを回避するためで、高速化が図れるかは定かではありません。
※もっと高速に処理する方法があると思いますが、
今回はセル範囲をFor Each 〜 Nextでループしながらがテーマですよね?

投稿日時: 17/11/14 09:09:34
投稿者: Dellcasio

もこな2さん、baooさん、
ご回答ありがとうございました。
まだ私には難しいコードなので時間が掛かると
思いますが、勉強して理解して参ります。
ありがとうございました。