Vba 如何将一系列For循环块缩短为一个

我这里有一系列包含For循环的代码块，我想缩小这段代码的规模，使它可以以同样的方式工作，但长度大约与这些代码块中的一块一样长，而不是长度为12块。如您所见，每个块都是一组6个，我在这里面临的挑战是缩短代码，同时将变量保持在6个组中。在这个程序中，值在两列中生成，并按顺序进行。 例如：

当m为1到6时，所有六个值的值p都需要为1

当m为7到12时，所有六个值的值p都需要为2

当m为13到18时，所有六个值的值p都需要为3

等等

For m = 1 To 6 'Riser
        For p = 1 To 1 'Car
            If Not IsEmpty(ws.Range("Riser" & m)) And Not IsEmpty(ws.Range("Car_" & p)) Then
                ws.Range("C1").Offset(m).Value = p
                Exit For
            End If
        Next p
    Next m

For m = 7 To 12 'Riser
    For p = 2 To 2 'Car
        If Not IsEmpty(ws.Range("Riser" & m)) And Not IsEmpty(ws.Range("Car_" & p)) Then
            ws.Range("C1").Offset(m).Value = p
            Exit For
        End If
    Next p
Next m

For m = 13 To 18 'Riser
    For p = 3 To 3 'Car
        If Not IsEmpty(ws.Range("Riser" & m)) And Not IsEmpty(ws.Range("Car_" & p)) Then
            ws.Range("C1").Offset(m).Value = p
            Exit For
        End If
    Next p
Next m

For m = 19 To 24 'Riser
    For p = 4 To 4 'Car
        If Not IsEmpty(ws.Range("Riser" & m)) And Not IsEmpty(ws.Range("Car_" & p)) Then
            ws.Range("C1").Offset(m).Value = p
            Exit For
        End If
    Next p
Next m

For m = 25 To 30 'Riser
    For p = 5 To 5 'Car
        If Not IsEmpty(ws.Range("Riser" & m)) And Not IsEmpty(ws.Range("Car_" & p)) Then
            ws.Range("C1").Offset(m).Value = p
            Exit For
        End If
    Next p
Next m

For m = 31 To 36 'Riser
    For p = 6 To 6 'Car
        If Not IsEmpty(ws.Range("Riser" & m)) And Not IsEmpty(ws.Range("Car_" & p)) Then
            ws.Range("C1").Offset(m).Value = p
            Exit For
        End If
    Next p
Next m

For m = 37 To 42 'Riser
    For p = 7 To 7 'Car
        If Not IsEmpty(ws.Range("Riser" & m)) And Not IsEmpty(ws.Range("Car_" & p)) Then
            ws.Range("C1").Offset(m).Value = p
            Exit For
        End If
    Next p
Next m

For m = 43 To 48 'Riser
    For p = 8 To 8 'Car
        If Not IsEmpty(ws.Range("Riser" & m)) And Not IsEmpty(ws.Range("Car_" & p)) Then
            ws.Range("C1").Offset(m).Value = p
            Exit For
        End If
    Next p
Next m

For m = 49 To 54 'Riser
    For p = 9 To 9 'Car
        If Not IsEmpty(ws.Range("Riser" & m)) And Not IsEmpty(ws.Range("Car_" & p)) Then
            ws.Range("C1").Offset(m).Value = p
            Exit For
        End If
    Next p
Next m

For m = 55 To 60 'Riser
    For p = 10 To 10 'Car
        If Not IsEmpty(ws.Range("Riser" & m)) And Not IsEmpty(ws.Range("Car_" & p)) Then
            ws.Range("C1").Offset(m).Value = p
            Exit For
        End If
    Next p
Next m

For m = 61 To 66 'Riser
    For p = 11 To 11 'Car
        If Not IsEmpty(ws.Range("Riser" & m)) And Not IsEmpty(ws.Range("Car_" & p)) Then
            ws.Range("C1").Offset(m).Value = p
            Exit For
        End If
    Next p
Next m

For m = 67 To 72 'Riser
    For p = 12 To 12 'Car
        If Not IsEmpty(ws.Range("Riser" & m)) And Not IsEmpty(ws.Range("Car_" & p)) Then
            ws.Range("C1").Offset(m).Value = p
            Exit For
        End If
    Next p
Next m

---

是否有一种方法可以增加这些值m和p，使它们增加到78，同时为每个块保持六组？

可能有一种更聪明的方法可以做到这一点，但我会使用模函数。当你除以两个数字时，模返回余数，因此如果你将

m

除以6，那么余数只有在

m

是6的倍数时才是0。在这种情况下，您只需增加我添加的名为

everySix

Dim everySix As Long
everySix = 1

Dim wasFound As Boolean

For m = 1 To 78
    If Not IsEmpty(ws.Range("Car_" & everySix)) Then

        If Not IsEmpty(ws.Range("Riser" & m)) And Not wasFound Then
            ws.Range("C1").Offset(m).Value2 = everySix
            wasFound = True
        End If

        If m Mod 6 = 0 Then
            everySix = everySix + 1
            wasFound = False
        End If

    End If
Next m

---

也许有一种更聪明的方法可以做到这一点，但我会使用模函数。当你除以两个数字时，模返回余数，因此如果你将

m

除以6，那么余数只有在

m

是6的倍数时才是0。在这种情况下，您只需增加我添加的名为

everySix

Dim everySix As Long
everySix = 1

Dim wasFound As Boolean

For m = 1 To 78
    If Not IsEmpty(ws.Range("Car_" & everySix)) Then

        If Not IsEmpty(ws.Range("Riser" & m)) And Not wasFound Then
            ws.Range("C1").Offset(m).Value2 = everySix
            wasFound = True
        End If

        If m Mod 6 = 0 Then
            everySix = everySix + 1
            wasFound = False
        End If

    End If
Next m

---

您的内部

for

循环不是必需的。您只需将p=1到1的

替换为
p=1
，然后删除相应的
下一个p

也就是说，我认为以下结构可以稍微减少代码重复：

For m = 1 To 72 'Riser
    Select Case m
    Case 1 to 6
        p = 1
    Case 7 to 12
        p = 2
    ' and so on...
    End Select

    If Not IsEmpty(ws.Range("Riser" & m)) And Not IsEmpty(ws.Range("Car_" & p)) Then
        ws.Range("C1").Offset(m).Value = p
        'Exit For ' You might need to replace this line with something adequate if necessary
    End If
Next m

现在，
selectcase
语句将负责适当地为
p
赋值，您可以在一个循环中完成所有工作。如果每6米增加p的规则不是一成不变的，这个解决方案会更好。（以这种方式更改分配更容易。）

现在，如果你说每6米增加p的规则是一成不变的，那么我建议你改用


通常，我建议根据
m
将分配给
p
的值的逻辑移到它自己的函数中

Public Sub YourSubStartsHere()
' [...]
For m = 1 To 72 'Riser
    p = GetPFromM(m)
    If Not IsEmpty(ws.Range("Riser" & m)) And Not IsEmpty(ws.Range("Car_" & p)) Then
        ws.Range("C1").Offset(m).Value = p
        'Exit For ' You might need to replace this line with something adequate if necessary
    End If
Next m
End Sub

Private Function GetPFromM(ByVal m as Long) as Long
    ' Your preferred logic to get the new p here
    ' be it Select Case
    Select Case m
    Case 1 to 6
        GetPFromM = 1
    End Select
    ' or rounding up
    GetPFromM = Application.WorksheetFunction.RoundUp(m / 6, 0)
End Function

这样，如果需要的话，可以很容易地为p插入新规则。
您的内部
for
循环是不必要的。您只需将p=1到1的
替换为
p=1
，然后删除相应的
下一个p

也就是说，我认为以下结构可以稍微减少代码重复：

For m = 1 To 72 'Riser
    Select Case m
    Case 1 to 6
        p = 1
    Case 7 to 12
        p = 2
    ' and so on...
    End Select

    If Not IsEmpty(ws.Range("Riser" & m)) And Not IsEmpty(ws.Range("Car_" & p)) Then
        ws.Range("C1").Offset(m).Value = p
        'Exit For ' You might need to replace this line with something adequate if necessary
    End If
Next m

现在，
selectcase
语句将负责适当地为
p
赋值，您可以在一个循环中完成所有工作。如果每6米增加p的规则不是一成不变的，这个解决方案会更好。（以这种方式更改分配更容易。）

现在，如果你说每6米增加p的规则是一成不变的，那么我建议你改用


通常，我建议根据
m
将分配给
p
的值的逻辑移到它自己的函数中

Public Sub YourSubStartsHere()
' [...]
For m = 1 To 72 'Riser
    p = GetPFromM(m)
    If Not IsEmpty(ws.Range("Riser" & m)) And Not IsEmpty(ws.Range("Car_" & p)) Then
        ws.Range("C1").Offset(m).Value = p
        'Exit For ' You might need to replace this line with something adequate if necessary
    End If
Next m
End Sub

Private Function GetPFromM(ByVal m as Long) as Long
    ' Your preferred logic to get the new p here
    ' be it Select Case
    Select Case m
    Case 1 to 6
        GetPFromM = 1
    End Select
    ' or rounding up
    GetPFromM = Application.WorksheetFunction.RoundUp(m / 6, 0)
End Function

通过这种方式，如果需要，可以很容易地为p插入新规则。
这里有一个简单的解决方案：

For m = 1 To 72'Riser
    If Not IsEmpty(ws.Range("Riser" & m)) And Not IsEmpty(ws.Range("Car_" & ((m - 1) \ 6) + 1)) Then
        ws.Range("C1").Offset(m).Value = ((m - 1) \ 6) + 1
    End If
Next m

这里有一个简单的解决方案：

For m = 1 To 72'Riser
    If Not IsEmpty(ws.Range("Riser" & m)) And Not IsEmpty(ws.Range("Car_" & ((m - 1) \ 6) + 1)) Then
        ws.Range("C1").Offset(m).Value = ((m - 1) \ 6) + 1
    End If
Next m

按照OP代码的逻辑，我将如下所示：

For p = 1 To 12 ' loop through cars
    If Not IsEmpty(ws.Range("Car_" & p)) Then ' proceed only if current car isn't empty
        For m = (p - 1) * 6 + 1 To p * 6 'Riser ' loop through current car corresponding risers range
            If Not IsEmpty(ws.Range("Riser" & m)) Then ' if current riser isn't empty
                ws.Range("C1").Offset(m).Value = p ' mark with current car
                Exit For ' exit loop and process next car
            End If
        Next
    End If
Next

按照OP代码的逻辑，我将如下所示：

For p = 1 To 12 ' loop through cars
    If Not IsEmpty(ws.Range("Car_" & p)) Then ' proceed only if current car isn't empty
        For m = (p - 1) * 6 + 1 To p * 6 'Riser ' loop through current car corresponding risers range
            If Not IsEmpty(ws.Range("Riser" & m)) Then ' if current riser isn't empty
                ws.Range("C1").Offset(m).Value = p ' mark with current car
                Exit For ' exit loop and process next car
            End If
        Next
    End If
Next

很好的解决方案。我在考虑
Mod
，但想先找到另一种
Select Case
解决方案。（我更喜欢模运算，如果它能产生正确的结果——它看起来更平滑。）：）这不符合OP的代码逻辑，因为每个非空车都会在遇到相应的冒口第一个非空值时立即退出。而且
Not IsEmpty（ws.Range（“Car_”）和everySix））
检查正在重复，但没有任何用处：在通过相应的提升管循环之前，最好将其作为外部检查移动。这是一个不错的解决方案。我在考虑
Mod
，但想先找到另一种
Select Case
解决方案。（我更喜欢模运算，如果它能产生正确的结果——它看起来更平滑。）：）这不符合OP的代码逻辑，因为每个非空车都会在遇到相应的冒口第一个非空值时立即退出。此外，
Not IsEmpty（ws.Range（“Car_”）和everySix））
检查正在重复，但没有任何用处：在通过相应的冒口循环之前，最好将其作为外部检查移动。Dangit，是的，这是一个简单的解决方案，我很难进一步简化它：而不是Application.WorksheetFunction.RoundUp（m/6，0）使用（m-1）\6@EvR，我们需要整数：）@JvdV是的，这就是为什么\而不是/；-）@Evr，忽略：（.Perfect！但是您的版本从0开始，我对它进行了一点编辑：）Dangit，是的，这是一个简单的解决方案，我很难进一步简化它：而不是Application.WorksheetFunction.RoundUp（m/6，0）use（m-1）\6@EvR，我们需要整数：）@JvdV是的，这就是为什么\而不是/；-）@Evr，忽略：（.Perfect！但是您的版本从0开始，我对它进行了一些编辑：）您的内部循环是不必要的，因为它每次只从一个索引到同一个索引。它可以按照@marucciboy2删除。您的内部循环是不必要的，因为它每次只从一个索引移动到同一个索引。它可以按照@Marucciboy2删除，我认为这种方法也更容易阅读，特别是当有人是VBA新手时。
Not IsEmpty（ws.Range（“Car_“&p））
检查被重复，没有任何用处：在通过相应的提升环之前，最好将其作为外部检查进行移动。@DisplayName我同意。但是在循环中去掉它会让你