如何在VBA中用PasteSpecial粘贴函数计算值并提取随机笑话？

是否可以复制包含如下函数的区域：

=IFERROR(INDEX($J$3:$J$702,$M3,COLUMNS($B4:$B4)),""

并使用PasteSpecial将该函数生成的无格式值粘贴到相邻列？我研究了很多PasteSpecial相关帖子，但在我的数据集上无法实现，另外想确认工作表函数运行与VBA运行是否存在时序问题，恳请帮助。

背景信息 #

• J列是笑话列表，I列是对应的分类/流派。
• K、L、M列为辅助列，用于设置筛选和随机化笑话。
• E3是带数据验证的列表框，用户可选择笑话流派。
• 从E3选择流派后，会触发从B3开始的分类索引公式：

  =IFERROR(INDEX($I$3:$I$702,$M3,COLUMNS($A4:$A4)),""
  

• 以及从C3开始的对应笑话索引公式：

  =IFERROR(INDEX($J$3:$J$702,$M3,COLUMNS($B4:$B4)),""
  

问题详情 #

在ListBox_Change事件中，我尝试复制C4:C200区域，用PasteSpecial仅粘贴值到相邻的D4:D200区域，目的是从D列提取一个随机笑话显示到E1中（可能有更优方法，但我编程经验不足）。恳请帮助修正下方代码，或提供直接从C列或D列显示随机笑话的替代方案。

现有代码 #

Private Sub ListBox_Change()
    
    Dim wsTarget As Worksheet: Set wsTarget = Worksheets("Jokes")
    Dim wsTargetRange As Range: Set wsTargetRange = wsTarget.Range("$E$3")
    
    If wsTargetRange.Address(True, True) = "$E$3" Then
        Select Case wsTargetRange
            Case "art"
                Call Generate
            Case "birthday"
                Call Generate
            Case "Computer"
                Call Generate
            Case "English"
                Call Generate
            Case "general"
                Call Generate
            Case "library"
                Call Generate
            Case "math"
                Call Generate
            Case "music"
                Call Generate
            Case "PE/sports"
                Call Generate
            Case "science"
                Call Generate
            Case "SS/history"
                Call Generate
            Case "winter"
                Call Generate
            Case Else
                'Do nothing
        End Select
    End If
End Sub

Sub Generate()
    Dim ws As Worksheet, rng As Range, i As Long, v
    Set ws = Sheets("Jokes")
    
    Set rng = ws.Range("C4:C200")
    rng.Select
    With Selection
        .Copy
    End With
    DoEvents 'I'm not sure about this.
    
    ws.Range("D4:D200").PasteSpecial
    '    DoEvents
    
    Set rng = ws.Range("D4:D200")
    Do 'trying to omit any blank cells
        i = Application.RandBetween(1, rng.Cells.Count)
        v = rng.Cells(i).Value
    Loop While Len(v) = 0  'loop until cell has a value
    
    ws.Range("E1").Value = v
    Set rng = ws.Range("E1")
    
    Application.CutCopyMode = False
    
End Sub

解决方案 #

1. 修正PasteSpecial用法，确保仅粘贴值 #

你的PasteSpecial未指定参数，默认会粘贴全部内容（格式、公式等），需明确指定仅粘贴值：

ws.Range("D4:D200").PasteSpecial Paste:=xlPasteValues

2. 解决时序问题：强制公式计算完成后再执行操作 #

选择流派后，工作表公式需要时间重新计算，VBA可能在公式更新前就执行复制，导致粘贴旧值。可在复制前强制刷新计算：

' 强制全表计算
Application.CalculateFull
' 或仅计算目标区域
ws.Range("C4:C200").Calculate

3. 优化方案：跳过复制粘贴，直接从C列提取随机值 #

不需要复制到D列，可直接收集C列非空值并随机选取，既避免时序问题又简化代码：

Sub Generate()
    Dim ws As Worksheet, cell As Range
    Dim validValues As Collection, i As Long
    
    Set ws = Sheets("Jokes")
    Set validValues = New Collection
    
    ' 收集C列所有非空值
    For Each cell In ws.Range("C4:C200")
        If Len(cell.Value) > 0 Then
            validValues.Add cell.Value
        End If
    Next cell
    
    ' 随机选取一个有效值放到E1
    If validValues.Count > 0 Then
        i = Application.RandBetween(1, validValues.Count)
        ws.Range("E1").Value = validValues(i)
    Else
        ws.Range("E1").Value = "无匹配笑话"
    End If
End Sub

4. 简化ListBox_Change事件代码 #

无需逐个判断流派，只要E3有值就调用Generate：

Private Sub ListBox_Change()
    Dim wsTarget As Worksheet: Set wsTarget = Worksheets("Jokes")
    Dim wsTargetRange As Range: Set wsTargetRange = wsTarget.Range("$E$3")
    
    If wsTargetRange.Address = "$E$3" And Len(wsTargetRange.Value) > 0 Then
        Generate
    End If
End Sub

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