这是什么离散优化系列？

Answer 1

事实证明，这个幼稚的解决方案只需要调整即可。看一个细胞。尝试在右侧的列中找到相同的字母。如果你找到了，现在把它和​​那个单元格右边的任何东西交换。向下工作。 ColumnsPer 参数说明了实际使用情况，其中每列都有一个关联的数字列表，网格列交替使用标签、数字、标签……

Option Explicit
Public Const Row1 As Long = 4
Public Const ColumnsPer As Long = 1  '2, when RM, % 
Public Const BinCount As Long = 6  
Public Const ColCount As Long = 6

Private Sub reorder_items_max_left_to_right_repeats(wksht As Worksheet, _
    col1 As Long, maxBins As Long, maxRecipes As Long, ByVal direction As Integer)

    Dim here As Range
    Set here = wksht.Cells(Row1, col1)
        here.Activate
        
    Dim cond
    For cond = 1 To maxRecipes - 1
        Do While WithinTheBox(here, col1, direction)
            If Not Adjacent(here, ColumnsPer).Value = here.Value Then
                   Dim there As Range
                   Set there = Matching_R_ange(here, direction)
                If Not there Is Nothing Then swapThem Adjacent(here, ColumnsPer), there
            End If
NextItemDown:
            Set here = here.Offset(direction, 0)
                here.Activate
                'Debug.Assert here.Address <> "$AZ$6"
          DoEvents
        Loop
NextCond:
        Select Case direction
            Case 1
                Set here = Cells(Row1, here.Column + ColumnsPer)
            Case -1
                Set here = Cells(Row1 + maxBins - 1, here.Column + ColumnsPer)
        End Select
        here.Activate
    Next cond
End Sub

Function Adjacent(fromHereOnLeft As Range, colsRight As Long) As Range
    Set Adjacent = fromHereOnLeft.Offset(0, colsRight)
End Function

Function Matching_R_ange(fromHereOnLeft As Range, _
                         ByVal direction As Integer) As Range
    
    Dim rowStart As Long
        rowStart = Row1
        
    Dim colLook As Long
        colLook = fromHereOnLeft.Offset(0, ColumnsPer).Column
        
    Dim c As Range
    Set c = Cells(rowStart, colLook)
    
    Dim col1 As Long
    col1 = c.Column
    
    Do While WithinTheBox(c, col1, direction)
        Debug.Print "C " & c.Address
    
        If c.Value = fromHereOnLeft.Value _
        And c.Row <> fromHereOnLeft.Row Then
            Set Matching_R_ange = c
            Exit Function
        Else
                Set c = c.Offset(1 * direction, 0)
        End If
      DoEvents
    Loop
    'returning NOTHING is expected, often
End Function

Function WithinTheBox(ByVal c As Range, ByVal col1 As Long, ByVal direction As Integer)
    Select Case direction
        Case 1
            WithinTheBox = c.Row <= Row1 + BinCount - 1 And c.Row >= Row1
        Case -1
            WithinTheBox = c.Row <= Row1 + BinCount - 1 And c.Row > Row1
    End Select
    WithinTheBox = WithinTheBox And _
               c.Column >= col1 And c.Column < col1 + ColCount - 1
End Function

Private Sub swapThem(range10 As Range, range20 As Range)
    'Unlike with SUB 'Matching_R_ange', we have to swap the %s as well as the items
    'So set temporary range vars to hold %s, to avoid confusion due to referencing items/r_anges
    If ColumnsPer = 2 Then
        Dim range11 As Range
        Set range11 = range10.Offset(0, 1)
        
        Dim range21 As Range
        Set range21 = range20.Offset(0, 1)
        'sit on them for now
    End If
    
    Dim Stak As Object
    Set Stak = CreateObject("System.Collections.Stack")
        Stak.push (range10.Value)           'A
        Stak.push (range20.Value)           'BA
                   range10.Value = Stak.pop 'A
                   range20.Value = Stak.pop '_  Stak is empty now, can re-use
                   
    If ColumnsPer = 2 Then
        Stak.push (range11.Value)
        Stak.push (range21.Value)
                   range11.Value = Stak.pop
                   range21.Value = Stak.pop
    End If
End Sub