Excel VBA如何跳过带X的已填充单元格，向空白单元格无重复填充内容

核心修改说明 #

• 调整执行顺序，先校验选区有效性，再提取选区中的空白单元格，自动跳过所有已经有内容的单元格（包括标记为X的休息单元格）
• 改用字典记录已经填充过的人员，从根源上避免重复填充，比原代码的计数判断逻辑更可靠
• 增加了异常处理，当选区无空白单元格时直接退出，避免报错

修改后代码 #

Sub placements()
    Dim SrcRange As Range, FillRange As Range
    Dim c As Range, r As Long
    Dim BlankCells As Range
    Dim usedDict As Object
    Dim randomIndex As Integer, tempName As String
    
    ' 提前判断选区是否为有效单元格区域
    If TypeName(Selection) <> "Range" Then Exit Sub
    Set FillRange = Selection
    
    ' 仅提取选中区域内的空白单元格，自动跳过带X、已填充的单元格
    On Error Resume Next
    Set BlankCells = FillRange.SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    If BlankCells Is Nothing Then Exit Sub ' 没有空白单元格直接退出
    
    Set SrcRange = Worksheets("Placements").Range("A2:A8")
    r = SrcRange.Cells.Count
    
    ' 校验空白单元格数量不超过名单总人数，避免死循环
    If BlankCells.Cells.Count > r Then
        MsgBox "待填充空白单元格数量超过可用名单人数，无法完成无重复填充", vbExclamation
        Exit Sub
    End If
    
    ' 用字典记录已使用的人名，保证无重复
    Set usedDict = CreateObject("Scripting.Dictionary")
    
    Application.ScreenUpdating = False
    For Each c In BlankCells
        Do
            ' 随机取名单里的人员
            randomIndex = Int((r * Rnd) + 1)
            tempName = Application.WorksheetFunction.Index(SrcRange, randomIndex)
        Loop Until Not usedDict.exists(tempName) ' 直到取出未使用过的人名
        c.Value = tempName
        usedDict.Add tempName, True ' 标记为已使用
    Next
    Application.ScreenUpdating = True
End Sub

内容的提问来源于stack exchange，提问作者richard briggs