如何在宏 VBA 中使用循环进行分配？答案

【问题标题】：How to allocate using a loop in macro VBA?如何在宏 VBA 中使用循环进行分配？
【发布时间】：2021-03-12 09:19:27
【问题描述】：

我有一个数据集，我想对其执行分配，以下是约束：

每个容器只能装 310 件
我们可以混合颜色，但重点是最大化 310

下面的代码能够遍历每种颜色并将它们拆分为 310 的倍数。但是，当它到达白色和粉笔时，代码就会中断。

为了使代码正常工作，我们应该将 160 个白色、120 个粉笔和 30 个红色放入 1 个容器中（在同一行）。

由于下面的代码是按列进行迭代的，所以当它旁边的列为0，并且容器还没有达到最大容量时，它就不起作用了。它将下一个可用值推送到下一个容器

Sub sum_of_substract()
Dim i, r As Integer
Dim another As Integer
Dim LastRow As Long
LastRow = ActiveSheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
r = 5

Cells(LastRow + 1, 2).Formula = "=SUM(C" & LastRow + 1 & ":CO" & LastRow + 1 & ")"
For i = 3 To 93
While (Cells(4, i).Value) > 0
    If IsEmpty(ActiveSheet.Cells(4, i)) = False And Cells(4, i).Value < 310 And Cells(LastRow + 1, Value + Cells(4, i + 1).Value <= 310 Then
        Cells(LastRow + 1, 2).Formula = "=SUM(C" & LastRow + 1 & ":CO" & LastRow + 1 & ")"
        Cells(LastRow + 1, i).Value = Cells(4, i).Value
        Cells(4, i).Value = Cells(4, i).Value - Cells(4, i).Value
        Cells(LastRow + 1, i + 1).Value = Cells(4, i + 1).Value
        Cells(4, i + 1).Value = Cells(4, i + 1).Value - Cells(4, i + 1).Value
    
    
    
    ElseIf ActiveSheet.Cells(4, i) <> 0 And Cells(4, i).Value < 310 And Cells(LastRow + 1, 2).Value + Cells(4, i + 1).Value > 310 Then
        Cells(LastRow + 1, i + 1).Value = Cells(LastRow + 1, 2).Value - Cells(4, i + 1).Value
        Cells(LastRow + 1, 2).Formula = "=SUM(C" & LastRow + 1 & ":CO" & LastRow + 1 & ")"

    
    Else
        Cells(LastRow + 1, i).Value = 310
        Cells(4, i).Value = Cells(4, i).Value - 310
        Cells(LastRow + 1, 2).Formula = "=SUM(C" & LastRow + 1 & ":CO" & LastRow + 1 & ")"

    
End If
    LastRow = LastRow + 1

Wend

Next i

结束子

Dataset

【问题讨论】：

欢迎来到 SO！您能否更详细地描述您的任务及其解决方案的问题。不幸的是，数据图像和代码没有回答以下问题：为什么是从 3 到 93 的循环？什么是93？每个容器都应该有不同颜色的碎片，还是应该尽量减少一个容器中不同颜色的数量？看起来您需要将所有这些部件装入 53 个容器中，但细节很重要。
谢谢约翰！循环是 3 到 93，因为颜色从第 3 列到第 93 列开始。这里的目标是最小化使用的容器总数，并最小化一个容器中不同颜色的数量（如果一个容器最多应该有 6 种颜色）可能）
我猜测代码中提到的CO列是第93列。我怀疑，因为我不知道有多少颜色（Wikipedia给出了87种颜色的表格，直到CK列）。换句话说，您可以从上到下和从左到右移动，用下一种颜色的剩余填充每个容器，并用下一个尚未包装的颜色补充容器。当然，您首先需要创建恰好包含 310 种颜色的容器，并将它们排除在进一步处理之外。任务似乎越来越清晰了。
哦，由于机密性，我稍微操纵了手头的数据，这就是为什么有这么多颜色的原因。没错。我能够创建恰好包含 310 个只有 1 种颜色的容器。但是当它涉及 2 种或更多颜色时，代码似乎不起作用。您知道代码的哪一部分需要更改吗？

标签： excel vba loops if-statement

【解决方案1】：

此算法必须满足问题中描述的所有条件：

Sub AllocateToConrainers()
Const CONTAINER_CAPACITY As Integer = 310
Dim rCountsRange As Range
Dim aTemp As Variant
Dim aRests() As Integer
Dim iNextConrainerCount As Integer
Dim rowNextContainer As Long
Dim iNextColor As Long
    Set rCountsRange = [C2:CO2]
Rem Clear previous results
    [A3:CO100].Clear
Rem Repack source counts to work array aRests:
    aTemp = rCountsRange.Value
    ReDim aRests(1 To UBound(aTemp, 2))
    For iNextColor = 1 To UBound(aRests)
        If Trim(aTemp(1, iNextColor)) <> vbNullString Then aRests(iNextColor) = aTemp(1, iNextColor)
    Next iNextColor
Rem When moving from top to bottom, you need to know in which line to place the result for the next container:
    rowNextContainer = 3
Rem We will immediately pack the colors that completely occupy the container - 310, 620, 930, etc. pieces:
    For iNextColor = 1 To UBound(aRests)
        While (aRests(iNextColor) Mod CONTAINER_CAPACITY = 0) _
                And (aRests(iNextColor) > 0)
            Cells(rowNextContainer, iNextColor + 2) = CONTAINER_CAPACITY
            aRests(iNextColor) = aRests(iNextColor) - CONTAINER_CAPACITY
Rem After filling each container, we write down its number and count the number of colors that it contains:
            Cells(rowNextContainer, 1) = rowNextContainer - 2
            Cells(rowNextContainer, 2).FormulaR1C1 = "=COUNT(RC[1]:RC[90])"
            rowNextContainer = rowNextContainer + 1
        Wend
    Next iNextColor
Rem Pack the remaining pieces moving from left to right and filling the container to the top
    iNextConrainerCount = 0
    For iNextColor = 1 To UBound(aRests)
        While aRests(iNextColor) > 0
            If iNextConrainerCount + aRests(iNextColor) < CONTAINER_CAPACITY Then
                Cells(rowNextContainer, iNextColor + 2) = aRests(iNextColor)
                iNextConrainerCount = iNextConrainerCount + aRests(iNextColor)
                aRests(iNextColor) = 0
            ElseIf iNextConrainerCount + aRests(iNextColor) = CONTAINER_CAPACITY Then
                Cells(rowNextContainer, iNextColor + 2) = aRests(iNextColor)
                aRests(iNextColor) = 0
                iNextConrainerCount = 0
                Cells(rowNextContainer, 1) = rowNextContainer - 2
                Cells(rowNextContainer, 2).FormulaR1C1 = "=COUNT(RC[1]:RC[90])"
                rowNextContainer = rowNextContainer + 1
            ElseIf iNextConrainerCount + aRests(iNextColor) > CONTAINER_CAPACITY Then
                Cells(rowNextContainer, iNextColor + 2) = CONTAINER_CAPACITY - iNextConrainerCount
                aRests(iNextColor) = aRests(iNextColor) - (CONTAINER_CAPACITY - iNextConrainerCount)
                iNextConrainerCount = 0
                Cells(rowNextContainer, 1) = rowNextContainer - 2
                Cells(rowNextContainer, 2).FormulaR1C1 = "=COUNT(RC[1]:RC[90])"
                rowNextContainer = rowNextContainer + 1
            End If
        Wend
    Next iNextColor
End Sub

【讨论】：

谢谢你，约翰，它有效！在提出一些问题之前，我必须消化代码。