Question

我正在努力整合一个宏，根据一个值是上下四分之一上升还是在四分之一的同一季度保持自动手动选择一个符号（上/下箭头，等号）

我正在使用三个FOR EACH .... NEXT循环，每个循环都有自己的嵌入式if，elseif，else语句集。我认为处理这个问题的正确方法是让第一个循环遍历第一个旧值（例如A1），并将其存储在适当的UDF存储桶中，并在其中为其分配四分位数。一旦该循环结束，使用相同的过程运行新循环。一旦分配了两个值，第三个循环将比较两个四分位数，然后进行符号输入。然后它将重新开始并循环遍历指定范围内的所有单元格，直到完成所有单元格。

循环看起来正确迭代，但它似乎没有达到范围内的所有值。

我认为我的问题在于设置循环的方式。有谁知道更好的方法来解决这个问题？

理想情况下，代码查看b列中的第一个值，并为'currentQuart'变量赋值，然后循环到a列并为'oldQuart'变量赋值。完成后，第三个循环比较两个值并根据运算符输入一个字符。

功能，存储在模块中：

函数quartOne（ByVal cellValue As Variant）作为布尔值 quartOne =（cellValue＆gt; = 0.01且cellValue＆lt; = 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-100）存储！

Answer 1

你正在运行太多循环。

只需使用标准for循环循环一次，然后逐行比较每个单元格。

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

Excel VBA-嵌套For ... Next循环比较两个值 - 不循环遍历范围内的所有值

1 个答案: