Excel VBA跨过程共享变量报错(错误91)：快捷键运行变量未识别

错误原因 #

报错“对象变量或With块变量未设置(错误91)”的核心原因有两个：

1. 快捷键冲突：你自定义的Ctrl_Copy过程快捷键设置为Ctrl+C，但Excel内置的复制功能会优先触发，导致你的自定义过程根本没运行，rngMulti变量始终未赋值。
2. 变量作用域与上下文问题：模块级变量rngMulti在Excel重启、VBA项目重新编译或工作簿切换时可能被重置为Nothing，快捷键触发过程时无法读取之前的赋值。

解决方案1：优化全局变量方案 #

修改代码解决快捷键冲突，增强变量稳定性与错误检查：

Option Explicit
Public rngMulti As Range ' 改为公共变量，确保在整个VBA项目中保持赋值状态

Sub Custom_Copy()
' 快捷键设置为 Ctrl+Shift+C（避开Excel内置Ctrl+C）
    On Error GoTo Err_Step
    ' 先判断选中的是否为单元格区域
    If TypeName(Selection) <> "Range" Then
        MsgBox "请先选中单元格区域！", vbExclamation
        Exit Sub
    End If
    
    Selection.Copy ' 执行默认复制操作
    Set rngMulti = Selection ' 给公共变量赋值
Err_Step:
End Sub

Sub WL_Transpose()
' 快捷键设置为 Alt+Shift+V
    Dim r As Long, c As Long ' 修正原代码变量声明错误（原代码仅c为Long类型）
    Dim xr As Long, xc As Long
    Dim arr() As Variant
    Dim xcell As Range
    
    ' 检查变量是否已赋值
    If rngMulti Is Nothing Then
        MsgBox "请先执行自定义复制（Ctrl+Shift+C）选中区域！", vbExclamation
        Exit Sub
    End If
    
    r = rngMulti.Rows.Count
    c = rngMulti.Columns.Count
    
    ReDim arr(1 To c, 1 To r) ' 定义转置后的数组维度
    
    ' 填充数组：提取单元格地址（去除工作簿名称部分）
    For xr = 1 To c
        For xc = 1 To r
            arr(xr, xc) = Split(rngMulti.Cells(xc, xr).Address(external:=True), "]")(1)
        Next xc
    Next xr
    
    ' 批量写入转置数据并设置公式
    With ActiveCell.Resize(c, r)
        .Value = arr
        .Formula = "='" & .Formula
    End With
    
    ' 清空变量，避免下次误操作
    Set rngMulti = Nothing
End Sub

关键优化点 #

• 改用不冲突的快捷键Ctrl+Shift+C触发自定义复制，确保变量能被正确赋值
• 增加变量空值检查，避免直接访问空对象报错
• 修正变量声明错误（原代码中Dim r, c As Long仅c为Long类型，r为Variant）
• 用With语句批量设置公式，提升运行效率

解决方案2：无全局变量方案（更稳定） #

通过隐藏工作表存储临时地址，彻底避免全局变量重置问题：

Option Explicit

Sub Custom_Copy()
' 快捷键：Ctrl+Shift+C
    On Error GoTo Err_Step
    If TypeName(Selection) <> "Range" Then
        MsgBox "请选中单元格区域！", vbExclamation
        Exit Sub
    End If
    
    Selection.Copy
    ' 创建/获取隐藏临时工作表存储选中区域地址
    Dim tempWs As Worksheet
    On Error Resume Next
    Set tempWs = ThisWorkbook.Worksheets("TempStorage")
    On Error GoTo 0
    
    If tempWs Is Nothing Then
        Set tempWs = ThisWorkbook.Worksheets.Add
        tempWs.Name = "TempStorage"
        tempWs.Visible = xlSheetVeryHidden ' 彻底隐藏工作表
    End If
    tempWs.Range("A1").Value = Selection.Address(external:=True)
Err_Step:
End Sub

Sub WL_Transpose()
' 快捷键：Alt+Shift+V
    Dim rngMulti As Range
    Dim tempWs As Worksheet
    Dim r As Long, c As Long
    Dim xr As Long, xc As Long
    Dim arr() As Variant
    
    ' 读取临时存储的地址
    On Error Resume Next
    Set tempWs = ThisWorkbook.Worksheets("TempStorage")
    On Error GoTo 0
    
    If tempWs Is Nothing Or tempWs.Range("A1").Value = "" Then
        MsgBox "请先执行自定义复制（Ctrl+Shift+C）！", vbExclamation
        Exit Sub
    End If
    
    ' 恢复选中的区域对象
    On Error Resume Next
    Set rngMulti = Application.Range(tempWs.Range("A1").Value)
    On Error GoTo 0
    
    If rngMulti Is Nothing Then
        MsgBox "存储的区域无效，请重新复制！", vbExclamation
        tempWs.Range("A1").Clear
        Exit Sub
    End If
    
    r = rngMulti.Rows.Count
    c = rngMulti.Columns.Count
    ReDim arr(1 To c, 1 To r)
    
    For xr = 1 To c
        For xc = 1 To r
            arr(xr, xc) = Split(rngMulti.Cells(xc, xr).Address(external:=True), "]")(1)
        Next xc
    Next xr
    
    With ActiveCell.Resize(c, r)
        .Value = arr
        .Formula = "='" & .Formula
    End With
    
    ' 清空临时存储
    tempWs.Range("A1").Clear
End Sub

方案优势 #

不依赖全局变量，避免因Excel上下文变化导致的变量丢失，稳定性更强，适合长期使用。

操作步骤 #

1. 打开VBA编辑器（Alt+F11），替换原代码为上述任一版本
2. 设置自定义快捷键：
   • 按Alt+F8打开宏对话框，选中Custom_Copy，点击「选项」设置快捷键为Ctrl+Shift+C
   • 选中WL_Transpose，设置快捷键为Alt+Shift+V
3. 测试：选中目标区域→按Ctrl+Shift+C→选中粘贴起始单元格→按Alt+Shift+V即可完成带链接的转置粘贴

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