基于条件的Excel库位优化(Slotting)VBA代码修复需求

需求明确 #

• 数据列定义：A=SKU，B=重量，C=尺寸，D=库位（D列值固定不可修改）
• 触发移动条件：产品满足「尺寸>0.16」+「重量>5」+「所在库位（D列）包含"CL"」
• 移动规则：将符合条件的产品移至最近的不含"CL"的相邻库位行，其余产品依次填补空缺，全程不删除行

修复后的VBA代码 #

Sub OptimizeSlotting()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long, targetRow As Long
    Dim isMoved As Boolean
    
    ' 指定操作工作表（可根据实际修改表名）
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 从下往上遍历，避免内容移位导致的产品遗漏
    For i = lastRow To 2 Step -1
        ' 检查是否符合移动条件
        If ws.Cells(i, "C").Value > 0.16 And _
           ws.Cells(i, "B").Value > 5 And _
           InStr(1, ws.Cells(i, "D").Value, "CL", vbTextCompare) > 0 Then
            
            isMoved = False
            ' 优先查找上方最近的非CL库位行
            For targetRow = i - 1 To 2 Step -1
                If InStr(1, ws.Cells(targetRow, "D").Value, "CL", vbTextCompare) = 0 Then
                    ' 将目标行到原行的A-C内容向下移一行
                    ws.Range(ws.Cells(targetRow, "A"), ws.Cells(i - 1, "C")).Cut
                    ws.Cells(targetRow + 1, "A").Insert Shift:=xlDown
                    ' 把原产品移到目标行
                    ws.Range(ws.Cells(i, "A"), ws.Cells(i, "C")).Copy ws.Cells(targetRow, "A")
                    ' 清空原行A-C（需保留占位可注释此行）
                    ws.Range(ws.Cells(i, "A"), ws.Cells(i, "C")).ClearContents
                    isMoved = True
                    Exit For
                End If
            Next targetRow
            
            ' 上方无合适库位时，查找下方最近的非CL库位行
            If Not isMoved Then
                For targetRow = i + 1 To lastRow
                    If InStr(1, ws.Cells(targetRow, "D").Value, "CL", vbTextCompare) = 0 Then
                        ' 将原行到目标行前一行的A-C内容向上移一行
                        ws.Range(ws.Cells(i + 1, "A"), ws.Cells(targetRow, "C")).Cut
                        ws.Cells(i, "A").Insert Shift:=xlUp
                        ' 把原产品移到目标行
                        ws.Range(ws.Cells(i, "A"), ws.Cells(i, "C")).Copy ws.Cells(targetRow, "A")
                        ws.Range(ws.Cells(i, "A"), ws.Cells(i, "C")).ClearContents
                        isMoved = True
                        Exit For
                    End If
                Next targetRow
            End If
        End If
    Next i
    
    MsgBox "库位优化完成！", vbInformation
End Sub

关键修复说明 #

1. 遍历逻辑优化：从最后一行往上遍历，避免内容移位导致的产品遗漏处理
2. 禁用行删除：改用Cut+Insert实现内容移位，全程保留所有行，仅调整A-C列数据
3. 库位静态保障：全程不修改D列任何单元格的值，严格符合需求
4. 相邻库位查找：优先查找上方最近的非CL库位，若不存在则查找下方，保证移动到最近目标位置
5. 内容移位处理：根据目标行位置（上/下）执行对应移位操作，确保其余产品依次填补空缺

示例数据验证 #

原数据 #

处理后结果 #

（说明：SKU1符合条件，移至上方最近的REG02库位行；SKU3符合条件，移至下方最近的REG04库位行，其余产品依次填补原CL库位行）

内容的提问来源于stack exchange，提问作者Sharad Gupta