VBA选中单元格上下移动：现有代码问题及优化需求

针对原代码存在的两个问题，以下是优化后的实现，解决了覆盖"Annual Leave"行以及跳过无效周末行的需求：

Sub MoveDownOptimized()
    Dim selectedRange As Range
    Dim nextValidRow As Long
    Dim weekdayCol As Integer
    Dim ws As Worksheet
    Dim targetRowRange As Range
    Dim tempData As Variant
    Dim i As Long
    Dim hasData As Boolean
    
    Set ws = ActiveSheet
    Set selectedRange = Selection
    
    ' 检查选中区域是否已在表格底部
    If selectedRange.Row + selectedRange.Rows.Count - 1 >= ws.Rows.Count Then
        MsgBox "已到达底部"
        Exit Sub
    End If
    
    ' 定位"Weekday"列（假设表头在第1行）
    weekdayCol = 0
    On Error Resume Next
    weekdayCol = ws.Rows(1).Find(What:="Weekday", LookIn:=xlValues, LookAt:=xlWhole).Column
    On Error GoTo 0
    If weekdayCol = 0 Then
        MsgBox "未找到Weekday列"
        Exit Sub
    End If
    
    ' 查找选中区域下方的第一个有效行
    nextValidRow = selectedRange.Row + selectedRange.Rows.Count
    Do While nextValidRow <= ws.Rows.Count
        ' 跳过包含"Annual Leave"的行（此处假设该内容在首列，可根据实际调整列号）
        If ws.Cells(nextValidRow, 1).Value = "Annual Leave" Then
            nextValidRow = nextValidRow + 1
            Continue Do
        End If
        
        ' 根据Weekday值判断是否跳过当前行
        Select Case ws.Cells(nextValidRow, weekdayCol).Value
            Case "Sunday":
                ' 直接跳过周日行
                nextValidRow = nextValidRow + 1
            Case "Saturday":
                ' 检查周六行是否有数据（仅检查选中区域对应的列）
                hasData = False
                For i = selectedRange.Column To selectedRange.Column + selectedRange.Columns.Count - 1
                    If ws.Cells(nextValidRow, i).Value <> "" Then
                        hasData = True
                        Exit For
                    End If
                Next i
                If hasData Then
                    ' 周六行有数据，视为有效行
                    Exit Do
                Else
                    ' 周六行无数据，跳过
                    nextValidRow = nextValidRow + 1
                End If
            Case Else:
                ' 工作日或其他有效行，停止查找
                Exit Do
        End Select
    Loop
    
    ' 检查是否已无有效下移位置
    If nextValidRow > ws.Rows.Count Then
        MsgBox "已到达底部，无有效下移位置"
        Exit Sub
    End If
    
    ' 执行下移操作：将选中区域与有效行交换位置
    Set targetRowRange = ws.Rows(nextValidRow).Range(selectedRange.Address)
    tempData = targetRowRange.Value
    
    ' 将选中区域向下移动至有效行的位置
    selectedRange.Offset(nextValidRow - selectedRange.Row).Value = selectedRange.Value
    
    ' 将有效行的数据移至选中区域的起始位置
    selectedRange.Value = tempData
    
    ' 更新选中区域为下移后的位置
    selectedRange.Offset(nextValidRow - selectedRange.Row).Select
End Sub

优化说明： #

• 避免覆盖"Annual Leave"行：在查找目标下移行时自动跳过包含"Annual Leave"的行，确保这类特殊行不会被覆盖或移位。
• 智能处理周末行：直接跳过所有周日行；周六行仅在无数据时跳过，若存在数据则视为有效下移目标，通过遍历选中区域对应列判断数据存在性。
• 其他增强：自动定位"Weekday"列无需硬编码，增加边界检查避免超出表格范围，支持多行选中的下移操作并保持区域完整性。

内容的提问来源于stack exchange，提问作者Robert Hall