wps vba 问题

我先按“Quicker 调 WPS 的 COM/宏执行链路”和“VBA 代码本身在外部调用时的兼容性”两条线排查。你这个现象很像不是 VBA 逻辑错，而是 Quicker 把整段代码/命令传给 WPS 时某个语法或参数被 WPS COM 层拒绝。

我查到 Quicker 官方文档里有几条与你情况高度相关：WPS 需要安装 VBA 模块并开启“信任对于 Visual Basic 项目的访问”，而且 WPS 版本/组件差异会影响兼容性；同时 Quicker 的 Office 辅助是低权限方式，遇到提权启动、多个同名进程时也容易抓错对象或控制失败。

可以解决。你这个更像 Quicker → WPS 的 COM/VBA 注入执行链路问题，不是这段 VBA 逻辑本身错。因为同一段代码粘到 WPS VBA 编辑器里能正常跑，说明 WPS 的 VBA 运行环境基本没问题。

Quicker 官方文档也提示了几个关键点：WPS 需要安装 VBA 模块并开启“信任对于 Visual Basic 项目的访问”；WPS 版本和组件差异较大，不一定都能稳定运行；多个同名 WPS/Office 进程时，底层 COM 可能抓到错误的活动文档；Quicker 的 Office 辅助是低权限方式，不能控制管理员权限启动的 Office/WPS。

优先推荐的解决方案

方案 1：不要让 Quicker 直接执行整段复杂 VBA，只让它“调用已有宏”

这是最稳的。

把下面这段宏保存到 WPS VBA 模块里，例如目标文件的普通模块中。然后 Quicker 的“VBA宏名称或代码”里只填：

FreqCountMain

Quicker 文档明确支持“填写文档中已有宏的名称”，否则才填写完整宏代码。

这样做的好处是：Quicker 不再需要把整段代码注入 WPS，只是调用一个现成宏，能绕开很多 0x800A03EC、编码、注入、权限、VBProject 访问的问题。

我建议你改用这个版本

这个版本专门规避了几个 Quicker/WPS 外部调用时容易出问题的点：中文过程名、未限定 Workbook/Worksheet、Application.Transpose(dict.Keys)、错误值单元格、ScreenUpdating 未恢复等。

Sub FreqCountMain()
    On Error GoTo EH
    
    Dim selectedRng As Range
    Dim cell As Range
    Dim dict As Object
    Dim wb As Workbook
    Dim wsResult As Worksheet
    Dim v As Variant
    Dim k As Variant
    Dim arr() As Variant
    Dim i As Long
    Dim sheetName As String
    
    Application.ScreenUpdating = False
    
    If TypeName(Application.Selection) <> "Range" Then
        MsgBox "请先选中需要统计的单元格区域！", vbExclamation, "提示"
        GoTo CleanExit
    End If
    
    Set selectedRng = Application.Selection
    Set wb = selectedRng.Worksheet.Parent
    Set dict = CreateObject("Scripting.Dictionary")
    
    For Each cell In selectedRng.Cells
        v = cell.Value
        
        If Not IsError(v) Then
            If Len(CStr(v)) > 0 Then
                k = CStr(v)
                
                If dict.Exists(k) Then
                    dict(k) = CLng(dict(k)) + 1
                Else
                    dict.Add k, 1
                End If
            End If
        End If
    Next cell
    
    If dict.Count = 0 Then
        MsgBox "选中区域内无有效数据！", vbInformation, "提示"
        GoTo CleanExit
    End If
    
    Set wsResult = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
    
    sheetName = "频次统计_" & Format$(Now, "hhmmss")
    On Error Resume Next
    wsResult.Name = sheetName
    If Err.Number <> 0 Then
        Err.Clear
        wsResult.Name = "Freq_" & Format$(Now, "hhmmss")
    End If
    On Error GoTo EH
    
    wsResult.Range("A1").Value = "单元格内容"
    wsResult.Range("B1").Value = "出现频次"
    
    ReDim arr(1 To dict.Count, 1 To 2)
    
    i = 0
    For Each k In dict.Keys
        i = i + 1
        arr(i, 1) = k
        arr(i, 2) = dict(k)
    Next k
    
    wsResult.Range("A2").Resize(dict.Count, 2).Value = arr
    
    wsResult.Range("A1").CurrentRegion.Sort _
        Key1:=wsResult.Range("B1"), _
        Order1:=-4121, _
        Header:=1
    
    wsResult.Columns("A:B").AutoFit
    
    MsgBox "统计完成，结果已生成至新工作表。", vbInformation, "完成"

CleanExit:
    Application.ScreenUpdating = True
    Exit Sub

EH:
    Application.ScreenUpdating = True
    MsgBox "执行失败：" & Err.Number & vbCrLf & Err.Description, vbExclamation, "VBA错误"
End Sub

若还想在 Quicker 里直接放整段代码

可以用下面格式，过程名尽量用英文。Quicker 文档说新版支持用 'main:宏名 指定入口；但如果你的 Quicker 版本较旧，就删掉第一行，让 Sub FreqCountMain() 成为第一行。

'main:FreqCountMain
Sub FreqCountMain()
    '这里放上面完整代码
End Sub

排查顺序建议

先按这个顺序来，成功率最高：

1. 任务管理器里结束所有 WPS 相关进程，尤其是 et.exe、wps.exe。
2. 不要通过 Quicker 启动 WPS，改成双击表格文件或从开始菜单打开。
3. 确保 WPS 不是“以管理员身份运行”，Quicker 也不要和 WPS 权限级别不一致。
4. WPS 打开后，先点一下其他窗口，再切回 WPS，或最小化/还原一次，再运行 Quicker。
5. Quicker 里优先只填宏名 FreqCountMain，不要直接放整段复杂代码。
6. WPS 设置里确认已开启“信任对于 Visual Basic 项目的访问”。

第 4 点也有依据：Office 自动化里，外部程序用 GetObject/GetActiveObject 连接已运行的 Office 实例时，可能遇到 ROT 注册延迟；Office 应用通常在失去焦点后才把运行对象注册到 ROT，切换焦点/最小化还原可触发注册。 Quicker 社区也有人用类似思路解决过 0x800A03EC。

奇安信有没有可能是原因？

有可能，但不是第一嫌疑。

更准确地说：如果公司安全软件限制了 跨进程 COM 调用、VBProject 注入、脚本组件 CreateObject，Quicker 这种外部自动化工具就可能报 0x800A03EC；但你在 WPS VBA 编辑器里直接运行正常，只能证明 WPS 内部宏能跑，不能证明外部程序注入宏也没被拦。

可以用这个小宏在 Quicker 里测试：

Sub TestDict()
    Dim d As Object
    Set d = CreateObject("Scripting.Dictionary")
    d.Add "a", 1
    MsgBox d("a")
End Sub

如果这个也报错，重点查安全策略、脚本组件、WPS VBA 信任设置。
如果这个正常，再测：

Sub TestAddSheet()
    Dim ws As Worksheet
    Set ws = ActiveWorkbook.Worksheets.Add
    ws.Range("A1").Value = "ok"
End Sub

如果 TestDict 正常但 TestAddSheet 报错，多半是 Quicker 抓错 WPS 实例、活动工作簿不对、多个 WPS 进程、权限级别不一致。Microsoft 对类似 Excel 自动化错误也说明，COMException/0x800A03EC 这类错误常和外部自动化环境、文件/进程状态、Office 安装配置有关，不一定是 VBA 语法本身。

我的建议：最终采用“宏存在 WPS 里，Quicker 只调用宏名”的方式。这对公司电脑、WPS、Quicker、安全软件组合来说最稳。

确实是我上一版代码里 排序常量写错了。

我写的是：

Order1:=-4121

但 -4121 不是“降序”，它更接近 xlDown 这类方向常量。
真正的降序应该是：

Order1:=2

也就是 xlDescending = 2。

所以你看到的现象刚好对得上：前面统计和生成工作表成功了，执行到排序时报“无效的过程调用”，因此结果没有降序排列。

最小修改版

如果你想保留原结构，只改这一段：

wsResult.Range("A1").CurrentRegion.Sort _
    Key1:=wsResult.Range("B1"), _
    Order1:=2, _
    Header:=1

也就是把：

Order1:=-4121

改成：

Order1:=2

更推荐：完全绕开 WPS 的 Sort 方法

WPS 通过 Quicker 调 VBA 时，Range.Sort 有时比 Excel 更容易抽风。下面这个版本直接在 VBA 数组里排好序，再写入表格，不依赖 WPS 的排序功能，更稳。

你可以直接替换之前的 FreqCountMain：

Sub FreqCountMain()
    On Error GoTo EH
    
    Dim selectedRng As Range
    Dim cell As Range
    Dim dict As Object
    Dim wb As Workbook
    Dim wsResult As Worksheet
    Dim v As Variant
    Dim k As Variant
    Dim arr() As Variant
    Dim i As Long, j As Long
    Dim tmp1 As Variant, tmp2 As Variant
    Dim sheetName As String
    
    Application.ScreenUpdating = False
    
    If TypeName(Application.Selection) <> "Range" Then
        MsgBox "请先选中需要统计的单元格区域！", vbExclamation, "提示"
        GoTo CleanExit
    End If
    
    Set selectedRng = Application.Selection
    Set wb = selectedRng.Worksheet.Parent
    Set dict = CreateObject("Scripting.Dictionary")
    
    ' 统计频次
    For Each cell In selectedRng.Cells
        v = cell.Value
        
        If Not IsError(v) Then
            If Len(CStr(v)) > 0 Then
                k = CStr(v)
                
                If dict.Exists(k) Then
                    dict(k) = CLng(dict(k)) + 1
                Else
                    dict.Add k, 1
                End If
            End If
        End If
    Next cell
    
    If dict.Count = 0 Then
        MsgBox "选中区域内无有效数据！", vbInformation, "提示"
        GoTo CleanExit
    End If
    
    ' 写入数组
    ReDim arr(1 To dict.Count, 1 To 2)
    
    i = 0
    For Each k In dict.Keys
        i = i + 1
        arr(i, 1) = k
        arr(i, 2) = dict(k)
    Next k
    
    ' 在数组中按出现频次降序排列，避免调用 WPS 的 Range.Sort
    For i = 1 To UBound(arr, 1) - 1
        For j = i + 1 To UBound(arr, 1)
            If CLng(arr(j, 2)) > CLng(arr(i, 2)) Then
                tmp1 = arr(i, 1)
                tmp2 = arr(i, 2)
                
                arr(i, 1) = arr(j, 1)
                arr(i, 2) = arr(j, 2)
                
                arr(j, 1) = tmp1
                arr(j, 2) = tmp2
            End If
        Next j
    Next i
    
    ' 新建结果工作表
    Set wsResult = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))
    
    sheetName = "频次统计_" & Format$(Now, "hhmmss")
    
    On Error Resume Next
    wsResult.Name = sheetName
    If Err.Number <> 0 Then
        Err.Clear
        wsResult.Name = "Freq_" & Format$(Now, "hhmmss")
    End If
    On Error GoTo EH
    
    ' 写入结果
    wsResult.Range("A1").Value = "单元格内容"
    wsResult.Range("B1").Value = "出现频次"
    wsResult.Range("A2").Resize(dict.Count, 2).Value = arr
    
    wsResult.Columns("A:B").AutoFit
    
    MsgBox "统计完成，结果已生成至新工作表。", vbInformation, "完成"

CleanExit:
    Application.ScreenUpdating = True
    Exit Sub

EH:
    Application.ScreenUpdating = True
    MsgBox "执行失败：" & Err.Number & vbCrLf & Err.Description, vbExclamation, "VBA错误"
End Sub

你这次这个报错不是奇安信导致的，主要是我上一版排序常量写错了。
建议你直接用上面这个“数组内排序版”，以后通过 Quicker 调 WPS 会更稳。