Excel VBA-ネストされたFor ...次の2つの値を比較するループ - 範囲内のすべての値をループしない

Question

シンボルの手動選択を自動化するマクロを組み立てようとしています（上/下矢印、等号）は、値が四分位を上下に移動したか、四半期にわたって同じ四半期を維持したかに基づいて計算されます。

私はFOR EACH .... NEXTループを3つ使用しています。それぞれ、それ自身の埋め込みif、elseif、elseステートメントがあります。私は、これを処理する適切な方法は、最初のループを最初の古い値（A1など）に実行させ、四分位数が割り当てられた適切なUDFバケットにバケットを入れることだと考えています。ループが終了したら、同じ手順で新しいループを実行します。両方の値が割り当てられると、3番目のループは2つの四分位数を比較し、シンボルを入力します。その後、すべてのセルが設定されるまで、指定された範囲内のすべてのセルをループしてループします。

ループは正しく反復しているように見えますが、範囲内のすべての値をヒットしないようです。

私の問題は、ループの設定方法にあると思います。誰もがこれを処理するためのより良い方法を知っていますか？

理想的には、コードは、列bの最初の値を調べ、 'currentQuart'変数に値を割り当て、次に列aにループし、 'oldQuart'変数に値を割り当てます。これが行われると、第3のループは2つの値を比較し、演算子に基づいて文字を入力します。モジュールに保存されている

機能、：ブール quartOne =のよう

機能quartOne（バリアントとしてByVal cellValue）（cellValue> = 0.01 cellValue < = 25） エンド機能

Function quartTwo(ByVal cellValue As Variant) As Boolean 
    quartTwo = (cellValue >= 25.01 And cellValue <= 50) 
End Function 

Function quartThree(ByVal cellValue As Variant) As Boolean 
    quartThree = (cellValue >= 50.01 And cellValue <= 75) 
End Function 

Function quartFour(ByVal cellValue As Variant) As Boolean 
    quartFour = (cellValue > 75) 
End Function 

コード

Sub CommandButton1_Click（）

Dim cellOld As Range, cellCurrent As Range, cell As Range 
Dim oldRng1 
Dim currentRng1 As Range 

Dim oldQuart As Integer 
Dim currentQuart As Integer 


Set oldRng1 = ActiveSheet.Range("A1:A4") 

Set currentRng1 = ActiveSheet.Range("B1:B4") 


    For Each cellCurrent In currentRng1.Cells 

      For Each cellOld In oldRng1.Cells 

        For Each cell In currentRng1.Cells 

        'checks cellCurrent against functions in module and assigns variable 
         If quartOne(cellCurrent.Value) Then 
          currentQuart = 1 
         ElseIf quartTwo(cellCurrent.Value) Then 
          currentQuart = 2 
         ElseIf quartThree(cellCurrent.Value) Then 
          currentQuart = 3 
         ElseIf quartFour(cellCurrent.Value) Then 
          currentQuart = 4 
         Else 
         End If 


        'checks cellOld against functions in module and assigns variable 
           If quartOne(cellOld.Value) Then 
             oldQuart = 1 
           ElseIf quartTwo(cellOld.Value) Then 
             oldQuart = 2 
           ElseIf quartThree(cellOld.Value) Then 
             oldQuart = 3 
           ElseIf quartFour(cellOld.Value) Then 
             oldQuart = 4 
           Else 
           End If 


         'takes variable from above loops, runs through if/else and inputs corresponding character 
          If currentQuart = 1 And oldQuart = 1 Then 
           cell.Offset(, 1).Value = ChrW(&H3D) 
          ElseIf currentQuart = 1 And oldQuart > 1 Then 
           cell.Offset(, 1).Value = ChrW(&H2191) 
          ElseIf currentQuart = 2 And oldQuart < 2 Then 
           cell.Offset(, 1).Value = ChrW(&H2193) 
          ElseIf currentQuart = 2 And oldQuart = 2 Then 
           cell.Offset(, 1).Value = ChrW(&H3D) 
          ElseIf currentQuart = 2 And oldQuart > 2 Then 
           cell.Offset(, 1).Value = ChrW(&H2191) 
          ElseIf currentQuart = 3 And oldQuart > 3 Then 
           cell.Offset(, 1).Value = ChrW(&H2191) 
          ElseIf currentQuart = 3 And oldQuart = 3 Then 
           cell.Offset(, 1).Value = ChrW(&H3D) 
          ElseIf currentQuart = 3 And oldQuart < 3 Then 
           cell.Offset(, 1).Value = ChrW(&H2193) 
          ElseIf currentQuart = 4 And oldQuart < 4 Then 
           cell.Offset(, 1).Value = ChrW(&H2191) 
          ElseIf currentQuart = 2 And oldQuart = 4 Then 
           cell.Offset(, 1).Value = ChrW(&H3D) 
          End If 
          Exit For 

       Next cell 
      Next cellOld 
    Next cellCurrent 


End Sub 

！テストデータは、列a-bに1つの値（1〜100）として保存されます！

Answer 1

実行中のループが多すぎます。

標準のforループで1回ループし、各セルの行を行ごとに比較します。

Sub CommandButton1_Click() 

Dim i As Long 
Dim oldRng1 As Range 
Dim currentRng1 As Range 

Dim oldQuart As Integer 
Dim currentQuart As Integer 


Set oldRng1 = ActiveSheet.Range("A1:A4") 
Set currentRng1 = ActiveSheet.Range("B1:B4") 


For i = 1 To currentRng1.Rows.Count 

    'checks cellCurrent against functions in module and assigns variable 
    If quartOne(currentRng1(i, 1).Value) Then 
     currentQuart = 1 
    ElseIf quartTwo(ccurrentRng1(i, 1).Value) Then 
     currentQuart = 2 
    ElseIf quartThree(currentRng1(i, 1).Value) Then 
     currentQuart = 3 
    ElseIf quartFour(currentRng1(i, 1).Value) Then 
     currentQuart = 4 
    Else 
    End If 

    'checks cellOld against functions in module and assigns variable 
    If quartOne(oldRng1(i, 1).Value) Then 
     oldQuart = 1 
    ElseIf quartTwo(oldRng1(i, 1).Value) Then 
     oldQuart = 2 
    ElseIf quartThree(oldRng1(i, 1).Value) Then 
     oldQuart = 3 
    ElseIf quartFour(oldRng1(i, 1).Value) Then 
     oldQuart = 4 
    Else 
    End If 

    'takes variable from above loops, runs through if/else and inputs corresponding character 
    If currentQuart = 1 And oldQuart = 1 Then 
     currentRng1(i, 1).Offset(, 1).Value = ChrW(&H3D) 
    ElseIf currentQuart = 1 And oldQuart > 1 Then 
     currentRng1(i, 1).Offset(, 1).Value = ChrW(&H2191) 
    ElseIf currentQuart = 2 And oldQuart < 2 Then 
     currentRng1(i, 1).Offset(, 1).Value = ChrW(&H2193) 
    ElseIf currentQuart = 2 And oldQuart = 2 Then 
     currentRng1(i, 1).Offset(, 1).Value = ChrW(&H3D) 
    ElseIf currentQuart = 2 And oldQuart > 2 Then 
     currentRng1(i, 1).Offset(, 1).Value = ChrW(&H2191) 
    ElseIf currentQuart = 3 And oldQuart > 3 Then 
     currentRng1(i, 1).Offset(, 1).Value = ChrW(&H2191) 
    ElseIf currentQuart = 3 And oldQuart = 3 Then 
     currentRng1(i, 1).Offset(, 1).Value = ChrW(&H3D) 
    ElseIf currentQuart = 3 And oldQuart < 3 Then 
     currentRng1(i, 1).Offset(, 1).Value = ChrW(&H2193) 
    ElseIf currentQuart = 4 And oldQuart < 4 Then 
     currentRng1(i, 1).Offset(, 1).Value = ChrW(&H2191) 
    ElseIf currentQuart = 2 And oldQuart = 4 Then 
     currentRng1(i, 1).Offset(, 1).Value = ChrW(&H3D) 
    End If 
Next i 


End Sub