[推荐]谁说自定义函数不能修改其它单元格的值

祥和

忘了上附件。希望更多的高手下载参详。一定有人能够解决这个问题。

祥和

以下是彭希仁彭老师的作品，稍加修改而得，以下是代码。
Public myc
Public iiii As Integer
Public kkk As Integer
Public ksss As Integer
Function pengs(a)
    pengs = a
    kkk = pengs
    ksss = ksss + 1
    Set myc = New css
    Set myc.sht = ActiveSheet
End Function

以下是类模块css代码。
Public WithEvents sht As Worksheet
Private Sub sht_Change(ByVal Target As Range)
    On Error GoTo ren
    Set myc.sht = Nothing
    Set myc = Nothing
    MsgBox "发生变化的区域为:" & Target.Address, , "ChangeDemo"
    Cells(kkk, 1) = iiii
    Cells(kkk, 2) = ksss
    iiii = iiii + 1
ren:
End Sub

在一个工作表内有多个PENGS（）函数，它们都饮用了同一个单元格，改变这个单元格都运行了所有PENGS（）函数，但只有最后一个PENGS()函数运行了CSS模块，我想让所有的PENGS()函数都运行CSS模块，在线的大师们能解决么？是改变工作表事件，还是添加什么代码。。。。。。等等方法。谢谢。请看附件。

彭希仁

Public yunx
Public yunxii As Dictionary

Function yx(a)
    On Error GoTo ren
    运行 = "运行"
    yunxi = "Sub xi()" & Chr(10)
    arr = a
    For i = 1 To UBound(arr)
        If arr(i, 1) Like "range*" Or arr(i, 1) Like "Range*" Then arr(i, 1) = "ActiveSheet." & arr(i, 1)
        If arr(i, 1) <> "" Then yunxi = yunxi & arr(i, 1) & Chr(10)
    Next i
    yunxi = yunxi & "End Sub" & Chr(10)
    s = yunxii(yunxi)
    Set yunx = New csss
    Set yunx.sht = ActiveSheet
    Exit Function
ren:
    If a Like "call*" Or a Like "Call*" Then
        Application.Run Mid(a, 5, Len(a))
        Exit Function
    End If
    yunxi = "sub xi()" & Chr(10) & a & Chr(10) & "end sub"
   s = yunxii(yunxi)
    Set yunx = New csss
    Set yunx.sht = ActiveSheet
End Function
Public WithEvents sht As Worksheet
Private Sub sht_Change(ByVal Target As Range)
On Error GoTo ren
    Set yunx.sht = Nothing
    Set yunx = Nothing
    Set s = CreateObject("MSScriptControl.ScriptControl")
    s.Language = "VBScript"
    s.AddObject "ActiveWorkbook", ActiveWorkbook
    s.AddObject "Application", Application
    s.AddObject "Activesheet", ActiveSheet
    s.AddObject "sheets", Sheets
    s.AddObject "cells", Cells
    arr = yunxii.Keys
    For i = 0 To UBound(arr)
    s.addcode arr(i)
    s.Run "xi"
    Next i
    s.Reset
     yunxii.RemoveAll
ren:
End Sub

我没有调试,你参考以上代码.不过这种方法很容易引起连锁反应.小心再小心

祥和

给彭老师带来了麻烦。小生无以为报。
小生最大的缺点是专牛角尖专到底，希望得到彭老师的批评指教。
我在运行彭老师的代码时遇到困难：
Public yunxii As Dictionary '用户定义类型未定义
不知小生是在什么地方搞错了。
彭老师能上传附件吗。谢谢。

彭希仁

那是定义的一个字典,你需要引用这个控件一下

祥和

我真没用，看不懂。希望老师能够看看我的附件。

yanjun_lyg

以前也遇到过这种问题，学习了

yanjun_lyg

原帖由 ldy 于 2008-7-29 00:37 发表
QUOTE:以下是引用xq1234在2008-7-22 8:38:30的发言：彭兄啊，我看过你很多贴子，都相当不错。不过这个贴子嘛……在FUNCTION 函数过程中有什么代码加不进去啊？删除移动重命名文件、关闭计算机、删除工作表、打开另一 ...

在excel 2003中函数值为#VALUE!

smhf_6

我从未用过类模块，虽然没几句，因为不能用F8，看起来也累，似懂非懂。

这个函数能改变其它单元格的值，我一下子也想不出哪里能用上，
但是我发现，类模块中的变量在程序运行结束后能保存结果
如cells(1,1)=k
      k=k+1
随着函数的变化，这个K值不断会变化，除非关闭工作簿，则K又从初始值开始。

我以前写过一个东西，一定要分二步操作，第一步产生多个变量， 为第二步所使用，最后被迫通过单元格过渡，因为一个过程结束，变量并不保存数值，那么上面的这个功能是否可以用上呢？

彭希仁

原帖由 祥和 于 2008-11-23 22:05 发表
我真没用，看不懂。希望老师能够看看我的附件。

类
Public WithEvents sht As Worksheet
Private Sub sht_Change(ByVal Target As Range)
    On Error GoTo ren
    Set myc.sht = Nothing
    Set myc = Nothing
    For i = 1 To UBound(Split(kkk, ","))
        Cells(Split(kkk, ",")(i), 1) = iiii
        Cells(Split(kkk, ",")(i), 2) = ksss
        iiii = iiii + 1
    Next i
    kkk = ""
    MsgBox "发生变化的区域为:" & Target.Address, , "ChangeDemo"
ren:
  kkk = ""
End Sub

模块
Public myc
Public iiii As Integer
Public kkk
Public ksss As Integer
Function pengs(a)
    pengs = a
    kkk = kkk & "," & pengs
    ksss = ksss + 1
    Set myc = New css
    Set myc.sht = ActiveSheet
End Function