儿童传统画中秋节:VBA中excel自定义函数修改其他单元格内容_生活是我的想象

有朋友请帮忙做一个功能 方便物料清单的复制 有两个思路 一是用函数带参数方法输入 另外就是用快捷键带输入框调用宏过程 完全用鼠标进行交互操作 基于我对交互操作不是很熟 选择前一种方法 在试验过程中发现 通常的函数过程无法修改单元格内容 一旦涉及修改操作则返回无效数据类型 郁闷沮丧的我踏上了百度之路 在百度知道里找了半天终于翻出一条有价值的信息 有位叫彭大师的网友公布了他的方法 思路相当巧妙 在此表示感谢

根据他的方法我修改成自己想要的 中间调试了很久 中途曾经想放弃换其他思路 但功夫不负有心人 总算调通 废话少说 上代码（自己看，不负责解答问题）：

模块部分

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的单元格处为左上顶点出现

SE800-R-BASE3-001 1 INE 101 0520 1 INE 101 0517 2 INE 101 0814 2 INE 101 0933 1 INE 101 0565 1 INE 101 0534 1 INE 101 0533 1

又如A3单元格内容为SE800-R-BASE3-001的话 输入=f(A3,4,24,3)则会在以行24列3的单元格处为左上顶点出现

SE800-R-BASE3-001 4 INE 101 0520 4 INE 101 0517 8 INE 101 0814 8 INE 101 0933 4 INE 101 0565 4 INE 101 0534 4 INE 101 0533 4

对这一块不熟 所以花了大半夜的时间做完 发上来供有需要的朋友参考 “人人为我，我为人人”\(^o^)/~