Question

我这里有一系列包含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个，同时每个块保持6个一组？

Answer 1

也许有更聪明的方法可以做到这一点，但是我将使用模函数。当您将两个数字相除时，模将返回余数，因此，如果将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

Answer 2

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

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

Answer 3

按照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

Answer 4

您的内部for循环不是必需的。您只需将for p = 1 to 1替换为p = 1并删除相应的Next 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

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

现在，如果您说每6 m增大规则是固定的，那么我建议您改用@Marcucciboy2's answer。

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

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循环块缩短为一个

4 个答案: