如何对两列数字进行排序，以最小化它们之间的差异？

Question

我正在对两列数字进行排序。一列是一系列线轴，另一列是一系列所需长度。我想优化所需长度的线轴选择，同时标记差异大于 +/- 10% 的线轴以供返回。-10% 表示“所需长度”列中的 10% 超额。

换句话说，我想优化此列表，将“原始长度”（即我库存的长度）中的数字与“修订长度”（即所需长度）中的数字配对，以尽量减少它们之间的差异，然后标记超出 10% 范围的差异。我还需要跟踪卷轴编号，以便标记要退回的卷轴。

关于如何有效地实现这一目标有什么想法吗？

下面是我正在处理的数据的一个示例：

线长表

Answer 1

在名为“Sheet1”的工作表的 A 列和 B 列中，我们有 2 列长度（这是从 100 到 1000 范围内的随机生成的值）。

我们打开 VBA 编辑器（Alt-F11）并添加通用模块（插入 - 模块）。在此模块中我们插入以下代码：

Sub SetPairs()
Dim sh As Worksheet
Dim i As Integer, len1 As Integer, len2 As Integer
Const Difference As Single = 0.1 ' 10% '

Set sh = ThisWorkbook.Worksheets("Sheet1")
With sh.Sort
    .SortFields.Clear
    .SortFields.Add Key:=Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
    .SetRange Range("A:A")
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    .SortFields.Clear
    .SortFields.Add Key:=Range("B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
    .SetRange Range("B:B")
    .Apply
End With
i = 2
Do
    len1 = sh.Cells(i, 1).Value
    len2 = sh.Cells(i, 2).Value
    If 1# * len1 * len2 = 0 Then Exit Do
    If Abs(len1 - len2) / (len1 + len2) > Difference / 2 Then
        If len1 > len2 Then
            Cells(i, 1).Insert xlShiftDown
        Else
            Cells(i, 2).Insert xlShiftDown
        End If
    End If
    i = i + 1
Loop
End Sub

然后我们执行此代码并得到以下结果：

差异小于 10% 的对属于同一行，没有匹配配对值的值保持单独。

PS. 10% 是近似值 - 我使用公式（差值的绝对值小于总和的 5%）。您可以自由更改它。

Answer 2

不确定你到底想要什么。

但或许：

• 将原件与卷轴编号一起排序
• 修订版排序
• 计算 %Diff
• 标记长度差异在 +/- 10% 之外的内容

如果是这样，如果您拥有具有最新SORT功能的 O365/Excel 以及条件格式，则可以使用公式来执行此操作。

如果您没有该SORT功能，您可以轻松设置查询来完成相同的操作，甚至可以使用Excel 中的选项Power Query手动完成。Data Sort

见下文：

F3: =SORT(A2:B11,2)
H3: =SORT(C2:C11)
I3: =1-(H3/G3) (and fill down)

然后选择结果表数据F3:I12

带有公式的条件格式： =ABS($I3) > 0.1

笔记：

• 这种方法无法提供最佳答案
  • 如果所需长度的数量与实际长度不同
  • 您可能希望将几种所需的长度组合起来，以“加起来”为单个卷轴的长度。

如果您需要真正的优化，您将需要一个 VBA 解决方案。