vba做个小程序

这是可以用VBA实现的，但"分享"的过程不像一般程序执行的那么方便：

1

先行在VBA的模块单元建立好所述的各种SUB、FUNCTION小模块[程序]；包括含有各种按钮控件的SUB[比如叫"调用"]，内里建立好调用的各种逻辑关系；

2

在VBA的"ThisWorkbook"页面的"Sub

Workbook_Open()"加入让文档被启动时即加载"SUB

调用()"即可；

3

以上是对一个文档的 *** 作而言的；如果想让对方在某一电脑或网域内通用，则须建立好一个域内均可随时提取到的公共模块文档，把上述1中所建立起来的所有模块装进1个或多个文档模块，同时做好说明文件，让所有人能清晰地知道有什么模块可以调用，如何调用[在哪(路径)、名称、功能、输入参数等等]；

之后让有需要的人，在自己建立的文档依上述2的方法，启动调用程序即可。

Sub 合并至总表()

 Dim Rng As Range, Rng1 As Range, Rng2 As Range, Sh As Worksheet

 Dim Dic As Object, i1&, j1&, i2&, j2&, K1$, K2$, K3$, i0&

 K1 = "水果": K2 = "其他1": K3 = "其他2"

 Set Dic = CreateObject("Scripting.Dictionary")

 Application.ScreenUpdating = False

 Application.DisplayAlerts = False

 Application.EnableEvents = False

 For Each Sh In Worksheets

  Dic(Sh.Name) = ""

 Next Sh

 If Not Dic.exists("总表") Then

  Worksheets.Add before:=Worksheets(1)

  ActiveSheet.Name = "总表"

 Else

  Worksheets("总表").Cells.ClearContents

 End If

 i0 = 0

 With Worksheets("总表")

  For Each Sh In Worksheets

   If Sh.Name <> .Name Then

    Set Rng = Sh.Cells.Find(what:=K1)

    '总表采用第一个分表的两行表头

    If (Not Rng Is Nothing) And i0 = 0 Then

     Rng.Resize(2, 9).Copy .Cells(1, 1)

     i0 = 2

     j1 = 3: j2 = 3

    End If

    Set Rng1 = Sh.Cells.Find(what:=K2)

    Set Rng2 = Sh.Cells.Find(what:=K3)

    If Rng Is Nothing Or Rng1 Is Nothing Or Rng2 Is Nothing Then

    Else

     Set Rng = Rng.Offset(i0, 0)

     .Cells(j1, 1).Resize(Rng1.Row - Rng.Row, 5) = Rng.Resize(Rng1.Row - Rng.Row, 5).Value

     .Cells(j2, 6).Resize(Rng2.Row - Rng.Row, 4) = Rng.Offset(0, 5).Resize(Rng2.Row - Rng.Row, 4).Value

     j1 = j1 + Rng1.Row - Rng.Row

     j2 = j2 + Rng2.Row - Rng.Row

    End If

   End If

  Next Sh

  .Cells(1, 1).Resize(Application.WorksheetFunction.Max(j1, j2) - 1, 9).Borders.LineStyle = xlContinuous

 End With

 Application.EnableEvents = True

 Application.DisplayAlerts = True

 Application.ScreenUpdating = True

 Set Dic = Nothing

End Sub

---