马云谈团队精神的启示:VBA中excel自定义函数修改其他单元格内容_生活是我的想象
来源:百度文库 编辑:中财网 时间:2024/05/08 11:50:35
有朋友请帮忙做一个功能 方便物料清单的复制 有两个思路 一是用函数带参数方法输入 另外就是用快捷键带输入框调用宏过程 完全用鼠标进行交互操作 基于我对交互操作不是很熟 选择前一种方法 在试验过程中发现 通常的函数过程无法修改单元格内容 一旦涉及修改操作则返回无效数据类型 郁闷沮丧的我踏上了百度之路 在百度知道里找了半天终于翻出一条有价值的信息 有位叫彭大师的网友公布了他的方法 思路相当巧妙 在此表示感谢
根据他的方法我修改成自己想要的 中间调试了很久 中途曾经想放弃换其他思路 但功夫不负有心人 总算调通 废话少说 上代码(自己看,不负责解答问题):
模块部分
Public myc, mycc, aa, bb, cc, dd, Nam, Num
Function f(a As String, b As Integer, c As Integer, d As Integer)
On Error GoTo ren
f = ""
aa = a
bb = b
cc = c
dd = d
Nam = Array("INE 101 0520", "INE 101 0517", "INE 101 0814", "INE 101 0933", "INE 101 0565", "INE 101 0534", "INE 101 0533")
Num = Array(1, 2, 2, 1, 1, 1, 1)
Set myc = New css
Set myc.sht = ActiveSheet
Exit Function
ren:
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
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
Cells(cc, dd) = aa
Cells(cc, dd + 1) = bb
For i = 1 To UBound(Nam) + 1
Cells(cc + i, dd) = Nam(i - 1)
Cells(cc + i, dd + 1) = bb * Num(i - 1)
Next i
s.Reset
ren:
End Sub
将以上两部分的模块导入excel,使用时在需要的单元格上输入带参数的函数即可,例如输入
=f("SE800-R-BASE3-001",1,24,5)则以行24列5的单元格处为左上顶点出现
又如A3单元格内容为SE800-R-BASE3-001的话 输入=f(A3,4,24,3)则会在以行24列3的单元格处为左上顶点出现
对这一块不熟 所以花了大半夜的时间做完 发上来供有需要的朋友参考 “人人为我,我为人人”\(^o^)/~