ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 182|回复: 7

[求助] 写了一个自定义函数,输出内容的时候一直报错,找不到原因?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2024-8-17 17:42 | 显示全部楼层 |阅读模式
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
老师好,我写了一个自定义的VBA函数,想实现的功能 就是  让用户在单元格中输入这个函数,函数有两个参数,第一个是框选单元格区域,例如:A3:Z6    第二个是输出目标单个单元格的位置,  例如   AF2 单元格

回车完毕后,在AF2单元格 输出数据处理的结果,是一个扩展区域,调试下面代码过程中数据处理没有问题,但是就是无法在AF2单元格输出brr的内容,希望老师帮忙给看看,具体代码如下:
中间数据处理的过程可以忽略,运行没有问题,就是最后输出的时候一直无法正常输出。  关键的是这行代码:wsDest.Range(destCell.Address).Resize(k4, UBound(brr, 2)).Value = brr    一直输不出结果。
Function ProcessData2(sourceRange As Range, destCell As Range) As Variant
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim arr As Variant
    Dim brr() As Variant
    Dim i As Long, j As Long
    Dim m As Long
    Dim k1 As Long, k2 As Long, k3 As Long, k4 As Long
    Dim colCount As Long
    Dim stepSize As Long
   
    ' 获取源工作表和目标工作表
    Set wsSource = sourceRange.Worksheet
    Set wsDest = destCell.Worksheet ' 目标工作表应与目标单元格在同一工作表

    ' 将数据范围的值存入数组 arr
    arr = sourceRange.Value

    ' 重新定义数组 brr
    colCount = UBound(arr, 2) ' arr 的列数
    ReDim brr(1 To 1000, 1 To 3) ' 假设最多有 1000 行数据
   
    brr(1, 1) = "1个TRUE": brr(1, 2) = "2个TRUE": brr(1, 3) = "3个以上TRUE"
   
    ' 确定最后一行
    m = UBound(arr, 1)
    k1 = 1: k2 = 1: k3 = 1
    ' 处理数据
    stepSize = 3
    For i = 1 To colCount - 3 Step stepSize
        If arr(m - 1, i + 2) = True And arr(m - 2, i + 2) = True And arr(m - 3, i + 2) = True Then
            k3 = k3 + 1
            brr(k3, 3) = arr(m, i + 1)
        ElseIf arr(m - 1, i + 2) = True And arr(m - 2, i + 2) = True Then
            k2 = k2 + 1
            brr(k2, 2) = arr(m, i + 1)
        ElseIf arr(m - 1, i + 2) = True Then
            k1 = k1 + 1
            brr(k1, 1) = arr(m, i + 1)
        End If
    Next i

    ' 确保 k4 为有效值
    k4 = Application.WorksheetFunction.Max(k1, k2, k3)
   
    ' 清除目标区域的内容(如果需要的话)
     wsDest.Range(destCell.Address).Resize(999, 3).ClearContents
   
   
     If k4 > 0 Then
      
        wsDest.Range(destCell.Address).Resize(k4, UBound(brr, 2)).Value = brr
      
        ProcessData2 = "true"
    Else
        wsDest.Range(destCell.Address).Value = "No Data"
        ProcessData2 = "false"
    End If
   
   
    ' 将结果作为函数返回值
  
   
End Function



TA的精华主题

TA的得分主题

 楼主| 发表于 2024-8-17 18:37 | 显示全部楼层
补充信息 我原本写好的 固定的程序代码是可以正常运行处结果的,固定的程序代码如下:
  1. Sub ProcessData()
  2.     Dim wsSource As Worksheet
  3.     Dim wsDest As Worksheet
  4.     Dim arr As Variant
  5.     Dim brr() As Variant
  6.     Dim i As Long, j As Long
  7.     Dim m As Long
  8.     Dim k1, k2, k3, k4 As Long
  9.    
  10.     Dim colCount As Long
  11.     Dim stepSize As Long

  12.     ' 指定工作表
  13.     Set wsSource = Sheet4
  14.     Set wsDest = Sheet11

  15.     ' 将数据范围的值存入数组 arr
  16.     arr = wsSource.Range("J242:ARO245").Value

  17.     ' 重新定义数组 brr
  18.     colCount = UBound(arr, 2) ' arr 的列数
  19.     ReDim brr(1 To colCount, 1 To 3) ' brr 的列数为 3
  20.    
  21.     brr(1, 1) = "1个TRUE": brr(1, 2) = "2个TRUE": brr(1, 3) = "3个以上TRUE"
  22.    
  23.     ' 确定最后一行
  24.     m = UBound(arr, 1)
  25.     k1 = 1: k2 = 1: k3 = 1
  26.     ' 处理数据
  27.     stepSize = 3
  28.     For i = 1 To colCount - 3 Step stepSize
  29.         If arr(m - 1, i + 2) = True And arr(m - 2, i + 2) = True And arr(m - 3, i + 2) = True Then
  30.             k3 = k3 + 1
  31.             brr(k3, 3) = arr(m, i + 1)
  32.         ElseIf arr(m - 1, i + 2) = True And arr(m - 2, i + 2) = True Then
  33.             k2 = k2 + 1
  34.             brr(k2, 2) = arr(m, i + 1)
  35.         ElseIf arr(m - 1, i + 2) = True Then
  36.             k1 = k1 + 1
  37.             brr(k1, 1) = arr(m, i + 1)
  38.         End If
  39.     Next i
  40.     k4 = Application.WorksheetFunction.Max(k1, k2, k3, k4)

  41.     ' 将 brr 输出到 Sheet2 的 A2 单元格
  42.     wsDest.Range("A2").Resize(k4, UBound(brr, 2)).Value = brr
  43.    
  44. End Sub

复制代码

TA的精华主题

TA的得分主题

发表于 2024-8-17 21:45 | 显示全部楼层
Set wsSource = sourceRange.Worksheet
Set wsDest = destCell.Worksheet ' 目标工作表应与目标单元格在同一工作表
这两句没明白意思,是不是要指定sourceRange所在的工作表?改成sourceRange.parent试试。
其他没细看。

TA的精华主题

TA的得分主题

发表于 2024-8-17 22:12 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
自定义函数不能操作工作表,过程可以。

TA的精华主题

TA的得分主题

发表于 2024-8-18 09:02 来自手机 | 显示全部楼层
星梦月缘 发表于 2024-8-17 18:37
补充信息 我原本写好的 固定的程序代码是可以正常运行处结果的,固定的程序代码如下:

参考一下以下链接
谁说自定义函数不能操作单元格
头像被屏蔽

TA的精华主题

TA的得分主题

发表于 2024-8-18 09:50 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽

TA的精华主题

TA的得分主题

 楼主| 发表于 2024-8-18 17:16 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
lss001 发表于 2024-8-18 09:02
参考一下以下链接
谁说自定义函数不能操作单元格

老师 你这个链接 打不开哈,提示手机端的信息

TA的精华主题

TA的得分主题

发表于 2024-8-18 17:48 来自手机 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
星梦月缘 发表于 2024-8-18 17:16
老师 你这个链接 打不开哈,提示手机端的信息

可使用手机打开链接
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-18 14:39 , Processed in 0.038764 second(s), 10 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表